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