I changed the format of the original sample to match the later version of the macro, including the slight rearranging of the columns
I think I captured your new format
Since the data area was larger, we need more columns to look at, and if looks like there were some UPPER/lower case changed in the data
Look at the attached version 1 and let me know
'!!!! Set rReport = Range(ws1.Cells(1, 1), rReportEnd).Resize(, 9)
Set rReport = Range(ws1.Cells(1, 1), rReportEnd).Resize(, 11)
'!!!!! If Left(.Cells(1).Value, 11) = "REPORT DATE" Then
If UCase(Left(.Cells(1).Value, 11)) = "REPORT DATE" Then
'!!!!! If Format(.Cells(9).Value) Like "1010######" Or .Cells(9).Value Like "[a-z][a-z]#####" Then
If Format(.Cells(9).Value) Like "1010######" Or .Cells(9).Value Like "[A-Za-z][A-Za-z]#####" Then
Option Explicit
Sub Extract_1()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rReport As Range, rReportEnd As Range, rReportRow As Range
Dim sReportDate As String, TxnID As String, MakerID As String, checkerID As String
Dim iRow As Long, iExtract As Long
Worksheets("Sheet1").Select ' <<<<<<< Just for testing
'setup
Application.ScreenUpdating = False
Set ws1 = ActiveSheet
Set rReportEnd = ws1.Cells(ws1.Rows.Count, 1).End(xlUp)
'!!!! Set rReport = Range(ws1.Cells(1, 1), rReportEnd).Resize(, 9)
Set rReport = Range(ws1.Cells(1, 1), rReportEnd).Resize(, 11)
iExtract = 1
'delete output sheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(ws1.Name & "-Extract").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'add extract sheet
Worksheets.Add(, ws1).Name = ws1.Name & "-Extract"
Set ws2 = Worksheets(ws1.Name & "-Extract")
'go down report
For Each rReportRow In rReport.Rows
With rReportRow
'REPORT DATE : 03-Dec-2018
'!!!!! If Left(.Cells(1).Value, 11) = "REPORT DATE" Then
If UCase(Left(.Cells(1).Value, 11)) = "REPORT DATE" Then
sReportDate = Mid(.Cells(1).Value, 15, 11)
ElseIf IsNumeric(.Cells(1).Value) Then
If Len(Format(.Cells(1).Value)) = 15 Then
TxnID = Format(.Cells(1).Value)
'MakerID and checkerID in 9 and 10 maybe
If Len(.Cells(8).Value) = 0 Then
'!!!!! If Format(.Cells(9).Value) Like "1010######" Or .Cells(9).Value Like "[a-z][a-z]#####" Then
If Format(.Cells(9).Value) Like "1010######" Or .Cells(9).Value Like "[A-Za-z][A-Za-z]#####" Then
MakerID = .Cells(9).Value
End If
If Format(.Cells(10).Value) Like "1010######" Or .Cells(10).Value Like "[A-Za-z][A-Za-z]#####" Then
checkerID = .Cells(10).Value
End If
'MakerID and checkerID in 8 and 10 maybe
ElseIf Len(.Cells(9).Value) = 0 Then
If Format(.Cells(8).Value) Like "1010######" Or .Cells(8).Value Like "[A-Za-z][A-Za-z]#####" Then
MakerID = .Cells(8).Value
End If
If Format(.Cells(10).Value) Like "1010######" Or .Cells(10).Value Like "[A-Za-z][A-Za-z]#####" Then
checkerID = .Cells(10).Value
End If
'MakerID and checkerID in 8 and 9 maybe
ElseIf Len(.Cells(10).Value) = 0 Then
' Debug.Print .Cells(10).Address
If Format(.Cells(8).Value) Like "1010######" Or .Cells(8).Value Like "[A-Za-z][A-Za-z]#####" Then
MakerID = .Cells(8).Value
End If
If Format(.Cells(9).Value) Like "1010######" Or .Cells(9).Value Like "[A-Za-z][A-Za-z]#####" Then
checkerID = .Cells(9).Value
End If
End If
'write to extract sheet
If Len(MakerID) > 0 Then
ws2.Cells(iExtract, 1).Value = MakerID
ws2.Cells(iExtract, 2).Value = sReportDate
ws2.Cells(iExtract, 3).Value = "'" & TxnID
ws2.Cells(iExtract, 4).Value = "China"
iExtract = iExtract + 1
End If
If Len(checkerID) > 0 Then
ws2.Cells(iExtract, 1).Value = checkerID
ws2.Cells(iExtract, 2).Value = sReportDate
ws2.Cells(iExtract, 3).Value = "'" & TxnID
ws2.Cells(iExtract, 4).Value = "China"
iExtract = iExtract + 1
End If
End If
End If
TxnID = vbNullString
MakerID = vbNullString
checkerID = vbNullString
End With
Next
'format and cleanup
ws2.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "Done"
End Sub