Global Keys As Variant
Global Headers As Collection
Global RegExp As Object
Sub ParseInvoice(ByVal Text As String)
Dim DataRow As Range
Dim Key As Variant
Dim LastRow As Long
Dim Matches As Object
Dim n As Long
Dim RegExp As Object
Dim Wks As Worksheet
Set Wks = ThisWorkbook.Worksheets("Sheet2")
Set DataRow = Wks.Range("A2")
LastRow = Wks.UsedRange.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False, False).Row
If LastRow >= DataRow.Row Then
Set DataRow = Wks.Cells(LastRow + 1, DataRow.Column)
End If
If Headers Is Nothing Then
Set Headers = New Collection
For Each Key In Wks.Range(Wks.Cells(1, "A"), Wks.Cells(1, Columns.Count).End(xlToLeft)).Value
Headers.Add n, Key
If n > 0 Then Keys = Keys & "|" & Key Else Keys = Key
n = n + 1
Next Key
End If
If RegExp Is Nothing Then
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.IgnoreCase = True
RegExp.Pattern = "\b(" & Keys & ")\s+(\d+)\b"
End If
Set Matches = RegExp.Execute(Text)
For Each Match In Matches
For j = 0 To Match.SubMatches.Count - 1 Step 2
DataRow.Offset(0, Headers(Match.SubMatches(j))).Value = Match.SubMatches(j + 1)
Next j
Next Match
End Sub
Sub Run()
Dim Line As Variant
Dim Text As String
Text = ThisWorkbook.Worksheets("Sheet1").Range("A1")
ThisWorkbook.Worksheets("Sheet2").UsedRange.Offset(1, 0).ClearContents
For Each Line In Split(Text, vbLf)
Call ParseInvoice(Line)
Next Line
End Sub
