Private Sub FindPattern(eWkb As Excel.Workbook)
On Error GoTo Err_FindPattern
Dim startCell As String
Dim rng As Excel.Range
Dim lastCell As Excel.Range
Dim cel As Excel.Range
Dim newCell As Boolean
Dim eWks As Excel.Worksheet
Dim eFinalAKZ As String
Dim eAKZ As String
Dim str_comment As String
On Error Resume Next
For Each eWks In eWkb.Worksheets
Set rng = eWks.UsedRange
On Error GoTo Err_FindPattern
If Not rng Is Nothing Then
On Error Resume Next
Set cel = rng.Cells(1).Find(What:="*", SearchDirection:=xlNext, LookAt:=xlPart)
If cel Is Nothing Then Set cel = rng.Find(What:="*", After:=rng.Cells(1))
On Error GoTo 0
If Not cel Is Nothing Then
newCell = True
Do While newCell
If findit(cel) Then
If eFinalAKZ <> "" Then eFinalAKZ = eFinalAKZ & ";"
eFinalAKZ = eFinalAKZ & returnit(cel)
End If
returnit (cel)
Set lastCell = cel
Set cel = rng.Find(What:="*", After:=cel)
newCell = (cel.Column > lastCell.Column And cel.Row = lastCell.Row) Or cel.Row > lastCell.Row
Loop
End If
End If
Next eWks
Debug.Print "Final Result - " & eFinalAKZ
'eFinalAKZ can be 3 things - nothing - many numbers with a ";" separator - just one AKZ
If InStr(eFinalAKZ, ";") > 0 Then
'AKZ has ";" in it so there is more than one. Get the first AKZ as the suggested one
'so take Left with the position from the first ";" that appears in the string
eAKZ = Left(eFinalAKZ, (InStr(eFinalAKZ, ";") - 1))
Else
'there is only one AKZ or nothing if nothing then both will be nothing
eAKZ = eFinalAKZ
End If
Set rng = Nothing
Set lastCell = Nothing
Set cel = Nothing
Set eWks = Nothing
Exit_FindPattern:
Exit Sub
Err_FindPattern:
MsgBox "FindPattern - " & Err.Description & " No." & Err.Number
Resume Exit_FindPattern
End Sub
Function findit(str) As Boolean
On Error GoTo Err_findit
Dim regex As Object
Dim itm As Variant
Set regex = CreateObject("vbscript.regexp")
With regex
.ignorecase = True
.Pattern = "\b[0-9]{4}[A-Z][0-9]{5}\b"
End With
findit = regex.test(str)
Exit_findit:
Exit Function
Err_findit:
MsgBox "Excelfindit - " & Err.Description & " No." & Err.Number
Resume Exit_findit
End Function
Function returnit(str) As String
On Error GoTo Err_returnit
Dim regex As Object
Dim itm As Object
Dim matches As Object
Set regex = CreateObject("vbscript.regexp")
With regex
.ignorecase = True
.Global = True
.Pattern = "\b[0-9]{4}[A-Z][0-9]{5}\b"
End With
Set matches = regex.Execute(str)
For Each itm In matches
If returnit <> "" Then returnit = returnit & ";"
returnit = returnit & itm
Next
Exit_returnit:
Exit Function
Err_returnit:
MsgBox "Excelreturnit - " & Err.Description & " No." & Err.Number
Resume Exit_returnit
End Function