Quote Originally Posted by Paul_Hossler View Post
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
Dear Paul,

This is great it's working. However out of the 4385 data only 2746 data was picked up. I tried to study the code and i think i understand why. For the codes that i highlight and bold as per below, this cell values has to be empty for them to capture it. If there is some values in it they will not pick up that row. Is that it? Is there a way we can change the code to say that irrelevant if any value in the cell be it empty or something?

'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