# 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


## Code Reduction

When a subroutine performs multiple tasks you should consider extracting each task into a separate subroutine. This will allow improve readability and make debugging easier by allowing you to focus on each tasks independently.

For example, extracting the code used for speed boosting from PatternScrub() into its own subroutine will reduce PatternScrub() from 42 to 32 lines of code. This will allow you to view the entire method without scrolling.

Sub SpeedBoost(TurnOn As Boolean)
With Application
.Calculation = IIf(TurnOn, xlCalculationManual, xlCalculationAutomatic)
.ScreenUpdating = Not TurnOn
.DisplayStatusBar = Not TurnOn
.EnableEvents = Not TurnOn
End With
End Sub


The code for extracting the pattern value should also be extracted into its own function. In this way, you can test the return value without running the main subroutine.

Private Function getPatternValue(Text As String) As String
Dim x As Long
x = PatternIndex(Text)
If x > 0 Then getPatternValue= Mid(Text, x, 13)
End Function


The Iff function can be used to replace an If statement where 1 of 2 values will be assigned. Although, not as efficient as an If statement, you will save 4 lines of code.

Mid(target, i, 1) = IIf(Mid(target, i, 1) = ".", 0, 1)


Although the PatternIndex Error Handler is probably considered the best practice; On Error Resume Next will always give you the same result (in this case).

Private Function PatternIndex(ByVal Pattern As String) As Integer

' MATCHES THE PATTERN AND RETURNS THE FIRST INDEX
On Error Resume Next
PatternIndex = Application.WorksheetFunction.Search("1101101110111", Pattern)

End Function


## Public Modules

The key to using Public Modules is to always fully qualify your Objects. Using With statements to do so will make your code more readable.

With ThisWorkbook.Worksheets("Sheet1")
Set targetRange = .Range("A1", .Range("A1").End(xlDown))
End With


Note: You should take a bottom up approach to defining dynamic ranges. If Column A was empty the code above would reference $A:$A that 1,048,576 cells, whereas, the code below would reference $A$1, 1 cell.

With ThisWorkbook.Worksheets("Sheet1")
Set targetRange = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
End With


## More Stuff

The Like operator should be used to test if the pattern exists before processing the cell.

For Each cell In targetRange

If cell.Value Like "*##.##.###.###*" Then
Pattern = Pattering(cell.Value)
x = PatternIndex(Pattern)
cell.Offset(0, 1).Value = Mid(cell.Value, x, 13)
End If

Next cell


Working with arrays will speed up the code considerably. The Refactored Code demonstrates an easy way to do so.

## Refactored Code

Sub PatternScrub()
Dim Pattern As String
Dim x As Integer
Dim data As Variant
Dim Target As Range

With ThisWorkbook.Worksheets("Sheet1")
Set Target = Range("A1", Range("A1").End(xlDown))
End With

data = Target.Value

SpeedBoost True                                   ' TO IMPROVE PERFORMANCE

For x = 1 To UBound(data)                         ' MAIN SCRUB

If data(x, 1) Like "*##.##.###.###*" Then
data(x, 1) = getPatternValue(CStr(data(x, 1)))
End If

Next

Target.Offset(0, 1).Value = data

SpeedBoost False
End Sub

Private Function Pattering(ByVal Target As String) As String
Dim i As Integer

For i = 1 To Len(Target)

Mid(Target, i, 1) = IIf(Mid(Target, i, 1) = ".", 0, 1) ' TURNS THE STRING INTO 1s AND 0s

Next

Pattering = Target

End Function

Private Function PatternIndex(ByVal Pattern As String) As Integer

On Error Resume Next
PatternIndex = Application.WorksheetFunction.Search("1101101110111", Pattern) ' MATCHES THE PATTERN AND RETURNS THE FIRST INDEX

End Function

Private Function getPatternValue(Text As String) As String
Dim x As Long
x = PatternIndex(Text)
If x > 0 Then getPatternValue = Mid(Text, x, 13)
End Function

Sub SpeedBoost(TurnOn As Boolean)
With Application
.Calculation = IIf(TurnOn, xlCalculationManual, xlCalculationAutomatic)
.ScreenUpdating = Not TurnOn
.DisplayStatusBar = Not TurnOn
.EnableEvents = Not TurnOn
End With
End Sub

• Sweet! I've never seen the IIF function. Also, I'd no idea you build a SpeedBoost on it's own procedure! But Most important of all, it's the Like statement. Thank you so much, once again Thomas. I'll go ahead and update my code, and post the answer to Super User. I'll make sure to add this and the other question as references. – Nahuatl_C137 Jan 29 '18 at 23:22
• You know what I'm having a hard time understanding; Target.Offset(0, 1).Value = data doesn't execute until after the loop. Does that mean that Excel holds all of those items in memory? – Nahuatl_C137 Jan 30 '18 at 2:00
• Ok, WOW! I just got it. data = Target.Value is the second array! That's genius. Do you know how many different projects I can go back to and add this to? That right there is game changing for me. – Nahuatl_C137 Jan 30 '18 at 2:03

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 <> 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.

• Thank you! The GoTo was kinda of a last resort as I kept running into errors while trying to search. That solves that. Correct, and I thought about that when working through the code; I considered looking for numbers, letters and periods, but from the examples given, it didn't make sense to do so. Also, there is always only one occurrence per string. Upon posting the answer, I'll make sure to make note of that. – Nahuatl_C137 Jan 28 '18 at 21:41

This is just an FYI to maybe get people to look at things a little different.

@Nahuatl_19650 all these answers are great but if you're trying to find a pattern there is a lot simpler way to do it. I made this with a user defined function (UDF) but you could add it to a sub or where ever needed.

Function StripIPAddress(myString As String) As String

For i = 1 To Len(myString)
If Mid(myString, i, 13) Like "??.??.???.???" Then
Exit For
End If
Next

End Function


Then call it in your worksheet like this:

=StripIPAddress(A1)


All this is doing is looping across the string and looking for the specific patern '??.??.???.???`

• Hi R. Roe! Your answer is definitely shorter and probably a lot easier to understand. However, a similar answer already existed in the question both using Regex functions and regular excel functions (similar to your mid function). The idea behind the code above was to take a different approach (hence the "without changing the logic" part. – Nahuatl_C137 Feb 4 '18 at 14:25