Extract Account numbers based on certain criteria

I have a source workbook called "Data Account number Import.xlsm " (Sheet “Data import”)

I need to extract the account numbers in Col G and paste these in Col M on workbook ‘Sales by Branch.xlsm” based on the following criteria

The criteria is a follows

1) Where the account no. in G and the positive value in Col I in "Sales by Branch.xlsm" sheet "Imported Data" matches the ref no in Col A and the Value in Col J on workbook "Data Account number Import.xlsm" sheet "Data Import" and the value in Col H on workbook "Sales by Branch.xlsm" sheet "Imported Data" is not zero, then the account number from Col G is to be copied from "Data Account number Import.xlsm" sheet "Data Import" and pasted in Col M in the destination workbook in the same row as the ref no. and value that matches
2) Where the account no. in G and the negative value in Col I in "Sales by Branch.xlsm" sheet "Imported Data" matches the ref no in Col A and the Value in Col K (these are shown as positive values , but they are in a column with the heading credit and are credit balances although shown as positive, hence the use of ABS in my code) on workbook "Data Account number Import.xlsm" sheet "Data Import" and the value in Col H on workbook "Sales by Branch.xlsm" sheet "Imported Data" is not zero, then the account number from Col G is to be copied from "Data Account number Import.xlsm" sheet "Data Import" and pasted in Col M in the destination workbook in the same row as the ref no. and value that matches

I have attached sample data files and also shown the manual result in Col N

The current code is extracting some of the account numbers, based on the above criteria but there is a few not being extracted which I have highlighted

It would be appreciated if someone would test my macro on workbook “Sales by Branch.xlsm” based on the above criteria and amend my code accordingly

Sub Extract_Account_Numbers()


With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With


Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("Sales by Branch.xlsm").Sheets("Imported Data")
Set sh2 = Workbooks("Data Account number Import.xlsm").Sheets("Data Import")
    With sh1
        For Each c In .Range("I2", .Cells(Rows.Count, "I").End(xlUp))
            If c.Value > 0 And c.Offset(, -1) <> 0 Then


                Set fn = sh2.Range("J:J").Find(Abs(c.Value), , xlFormulas, xlWhole)
                If Not fn Is Nothing Then
                    If fn.Offset(, -9).Value = c.Offset(, -2).Value Then
                        c.Offset(, 4) = fn.Offset(, -3).Value
                    End If
                End If
                Set fn = Nothing
           ElseIf c.Value < 0 And c.Offset(, -1) <> 0 Then
                Set fn = sh2.Range("K:K").Find(Abs(c.Value), , xlFormulas, xlWhole)
                If Not fn Is Nothing Then
                    If fn.Offset(, -10).Value = c.Offset(, -2).Value Then
                        c.Offset(, 4) = fn.Offset(, -4).Value
                    End If
                End If
                Set fn = Nothing
            End If
        Next
    End With
    With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

I have also attached my source & destination files Sales by Branch.xlsm Data Account number Import.xlsm

It would be appreciated if someone can test & amend my code

I have also posted on link below

https://forums.windowssecrets.com/sh...rtain-criteria