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