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 SubI 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