Extracting Four Specific Data for each Row. Complex and Disorganized Raw Data.

[Paul_Hossler]

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