VBA to match a line in one sheet based on a few criteria and move antire row to another sheet-CodePudding

I am quite new into VBA and all in all into programming.

I would like to create a tool that helps me to do some manual tasks.

So, background:

I work at one of many finance companies and we receive couple thousand trades daily and we have to match it - it is automated - the system receives the trade from outside (called HE side) and compares details with our database (Called ME side) and if the details the same it will match it. But a few hundred HE side trades get stuck in the system. And it is my job to clear the backlog manually.

To do that I have to download HE side and ME side separately (.xls files) and compare in excel.

I have tried a few VBA, but I could not do fully functioning tool.

I will download both files and paste it into one:

Sheet1 contains HE side trades, sheet2 " contains ME side trades. I want to make a tool that run through both sheets and based on matching criteria moves the row from A to Q to 3rd sheet. (from both sheet1 and sheet2) Problem is both trades are inverted:

Matching criteria is: sheet1 Columns I,J,M should match I,J,M on sheet2 respectively. And sheet1 column L should match sheet2 column O and vice versa (I have put colors above)

Based on this it should move matching rows from sheet1 and sheet2(A : Q) to sheet3 end product should look like this

Sheet1 and sheet2 contains data from A : AU but I only need to move A:Q Both sheets have a few hundred rows. And it should 1st matching rows 1st (if in sheet1 row 15 matches to sheet2 row 102 - it should move row 15 first and paste row 102 under it)

thank you, guys, for all help in advance!

CodePudding user response：

welcome to StackOverflow. It's great that you're thinking at automating your mundane tasks, but it would be even better if you give it a go yourself first, there are countless VBA tutorials around.

The below assumes you have the spreadsheets separated, and the results in a third spreadsheet (where this code would reside).

Anyways, see if this gives you a starting point at least:

Option Explicit

Sub findMatches()

    Application.ScreenUpdating = False

    'this workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wsDestination As Worksheet: Set wsDestination = wb.Sheets("your destination sheet name here")
    
    'get HIS workbook
    Dim wbHIS As Workbook: Set wbHIS = Workbooks.Open("C:\...yourpath...\wbHIS.xls")
    Dim wsHIS As Worksheet: Set wsHIS = wbHIS.Sheets("his sheet name here")
    
    'get ME workbook
    Dim wbME As Workbook: Set wbME = Workbooks.Open("C:\...yourpath...\wbME.xls")
    Dim wsME As Worksheet: Set wsME = wbME.Sheets("me sheet name here")
    
    'other variables
    Dim arrHis, arrME, arrDestination
    Dim i As Long, j As Long, x As Long, z As Long
    
    'get the data from the worksheets
    arrHis = getData(wsHIS)
    arrME = getData(wsME)
    
    If IsEmpty(arrHis) Or IsEmpty(arrME) Then GoTo exitSub
    
    'create the destination array with the max possible rows in case there is a match for every single row, assume same number of columns
    ReDim arrDestination(1 To UBound(arrHis, 1)   UBound(arrME, 1), 1 To UBound(arrME, 2))
    
    'iterate through all rows in his data
    x = 2
    For i = LBound(arrHis, 1)   1 To UBound(arrHis, 1)
        'iterate through all rows in me data
        For j = LBound(arrME, 1)   1 To UBound(arrME, 1)
            'if they match on columns "I", "J", "M"
            If arrHis(i, 9) = arrME(j, 9) _
                And arrHis(i, 10) = arrME(j, 10) _
                And arrHis(i, 13) = arrME(j, 13) Then
                
                'we add to the temp array
                For z = LBound(arrDestination, 2) To UBound(arrDestination, 2)
                    If x = 2 Then
                        'add headers
                        arrDestination(1, z) = arrHis(1, z)
                    End If
                    arrDestination(x, z) = arrHis(i, z)
                    arrDestination(x   1, z) = arrME(j, z)
                Next z
                x = x   2
                Exit For
            End If
        Next j
    Next i
    
    'now dump the data back to the worksheet
    With wsDestination
        .Range(.Cells(1, 1), .Cells(x - 1, UBound(arrDestination, 2))) = arrDestination
    End With

exitSub:
    'close the workbooks
    wbHIS.Close
    wbME.Close
    
    Application.ScreenUpdating = True

End Sub

Function getData(sht As Worksheet)
    With sht
        'allocate the data from the sheet to an array
        getData = .Range( _
            .Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
            .Cells(1, .Columns.Count).End(xlToLeft).Column) _
        )
    End With
End Function

There is very little error handling here, I leave that to you.

Let me know if it helps.