Excel VBA Retrieving a Specific Pattern from String The following VBA code is in response to a SuperUser question which I found interesting.

What I'm looking for in a response?


Code cleanliness. Can I do more to make the code easier to read and potentially debug in the future?
Code reduction. Is there anything else I can do, without changing the logic, to reduce the amount of code written?
The use of variants in code. I've noticed that the use of variants is frowned upon and with good reason. The memory needed for variants seems to be substantially larger than any other data type.
Use of modules. I've found that it's difficult for me to use modules as opposed to hosting the code within the Sheet or ThisWorkbook. Any comments on the use of modules?


Below is a screen shot of how my spreadsheet looks:


In the original question, the user is only asking to scrub 5 records. I duplicated them until I had 5K records. Completion time was 0.66 seconds. Speed doesn't seem like much of a concern in this case.




Below is the code. FYI, this is located in Sheet1:

Sub PatternScrub()

Dim targetRange As Range
Set targetRange = Range("A1", Range("A1").End(xlDown))

Dim Pattern As String
Dim x As Integer

' TO IMPROVE PERFORMANCE

With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayStatusBar = False
    .EnableEvents = False
End With

' MAIN SCRUB
For Each cell In targetRange

    Pattern = Pattering(cell.Value)

    x = PatternIndex(Pattern)

    If x = 0 Then
        GoTo NextIteration
    Else
        cell.Offset(0, 1).Value = Mid(cell.Value, x, 13)
    End If

NextIteration:

Next cell

With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .EnableEvents = True
End With

End Sub

Private Function Pattering(ByVal target As String) As String

' TURNS THE STRING INTO 1s AND 0s

Dim i As Integer

For i = 1 To Len(target)

   If Mid(target, i, 1) = "." Then
        Mid(target, i, 1) = 0
    Else
        Mid(target, i, 1) = 1
   End If

Next

Pattering = target

End Function

Private Function PatternIndex(ByVal Pattern As String) As Integer

' MATCHES THE PATTERN AND RETURNS THE FIRST INDEX

    On Error GoTo ErrorHandler

    PatternIndex = Application.WorksheetFunction.Search("1101101110111", Pattern)

ErrorHandler:

    Select Case Err.Number
        Case 1004
            PatternIndex = 0
    End Select

End Function
You can remove a goto - unconditional branches are strongly discouraged and in this case the code fall-through renders it unnecessary.

    If x = 0 Then
        GoTo NextIteration
    Else
        cell.Offset(0, 1).Value = Mid(cell.Value, x, 13)
    End If

NextIteration:


becomes

If x &lt;&gt; 0 Then cell.Offset(0, 1).Value = Mid(cell.Value, x, 13)


This code only works for a specific (hard coded) pattern without any variations. Your example (test case) focuses on numbers, but your pattern also matches aa.bb.ccc.ddd.