Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88854

How to create a another sheet using condition setting using Reglar Express VBA

$
0
0

Hi am trying to produce a another excel sheet using VBA by selecting matching values to another sheet. Currently it ends at the for loop and i have no idea how to carry on to produce the values that I want. Do help me as i am particularly new to VBA.

Option Explicit

Sub getOTC()
    'Dim strPattern As String: strPattern = "^[0-9]{1,2}"

    Dim DataSheet As Worksheet
    Dim TransferSheet As Worksheet
    Dim DataRange As Range
    Dim CheckRange As Range
    Dim R03 As Range
    Dim CopyRange As Range
    Dim PasteRange As Range


    Dim regexp As Object
    'Dim regex As New VBScript_RegExp_55.regexp
    Dim strInput As String
    Dim strPattern As String
    Dim rcell As Range

    strPattern = "([a-z])"'making sure that data sheet exist ( thus will tell (vaidation))

    If Not DoesSheetExist("Values", ThisWorkbook) Then
        MsgBox ("No Sheet Name ""Values"" found!")
        Exit Sub
    End If

    Set DataSheet = ThisWorkbook.Worksheets("Values")
    Set DataRange = DataSheet.Range("A2:AI18254")
    Set CheckRange = DataSheet.Range("H2:H18254")

    'using regexp to get the  value with other string value behind
    Set regexp = CreateObject("vbscript.regexp")
    With regexp
        .Global = False
        .MultiLine = False
        .ignoreCase = True
        .Pattern = strPattern
    End With

    For Each rcell In CheckRange.Cells
        If strPattern <> "" Then
            strInput = rcell.Value

            If regexp.test(strInput) Then
                MsgBox rcell & "Matched in Cell"& CheckRange.Address
            Else
                MsgBox " Could not find ""R03"" in the colum!"

            End If
            Exit Sub
        End If

        'a
        If DoesSheetExist("Products Sales", ThisWorkbook) Then
            MsgBox ("Dude, ""Products Sales"" sheet exist its goin to be deleted")
            Set TransferSheet = Worksheets("Products Sales")
            TransferSheet.Delete
        End If

        ' this one is to create the transferSheet
        Set TransferSheet = Worksheets.Add
        TransferSheet.Name = "Products Sales"

        CopyRange.Copy
        TransferSheet.Range("A1").PasteSpecial Paste:=xlPasteAll
    Next
End Sub

Public Function DoesSheetExist(SheetName As String, BookName As Workbook) As Boolean
    Dim obj As Object
    On Error Resume Next
    'only if there is an error, sheet doesnt exist

    Set obj = BookName.Worksheets(SheetName)
    If Err = 0 Then
        DoesSheetExist = True
    Else
        DoesSheetExist = False
    End If
    On Error GoTo 0
End Function

Viewing all articles
Browse latest Browse all 88854

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>