Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Option Explicit
Public Sub ExtractInfoFromSquareBrackets()
Dim wksRaw As Worksheet
Dim strPattern As String, strRaw As String, strMatch As String
Dim rngAllRows As Range, rngCell As Range
Dim lngLastRow As Long, lngIdx As Long
Dim objMatches As Object
Dim rgx As RegExp
Set rgx = New RegExp
'Set references up-front
Set wksRaw = ThisWorkbook.Sheets("raw")
strPattern = "(\[\S*?\])"
With rgx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = strPattern
End With
'Find the last-occupied row on the raw sheet
lngLastRow = wksRaw.Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Get all the rows into a single range for easy looping
With wksRaw
Set rngAllRows = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))
End With
'Loop through all the rows
For Each rngCell In rngAllRows
'Store the value from the cell for easy comparison
strRaw = CStr(rngCell.Value)
'If the string inside the cell hits our RegExp, start the operation
If rgx.Test(strRaw) Then
'Assign the matches inside the string to an object
Set objMatches = rgx.Execute(strRaw)
'Loop through the matches, removing the square brackets and
'writing the results to the neighboring cells
For lngIdx = 0 To (objMatches.Count - 1)
strMatch = objMatches.Item(lngIdx)
strMatch = Replace(strMatch, "[", "")
strMatch = Replace(strMatch, "]", "")
rngCell.Offset(0, lngIdx + 1).Value = strMatch
Next lngIdx
Else
rngCell.Offset(0, 1) = "No square brackets found!"
End If
Next rngCell
MsgBox "Completed!"
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.