copy values between sheets based on criteria using VB in excel

Question

Sorry I'm a noob, but I don't have time to learn enough VB to fix my problem. I would really appreciate some help as I'm sure there is a simple fix. I need to Match value from row7 columnA worksheetA to value in row? columnA worksheetB, then copy value from row7 ColumnD worksheetA to row? ColumnQ worksheetB.

Basically I have two worksheets, one is exported from our online store, the other is exported from our inventory management system in the store. I have to change the online store inventory values, to the real values that the in-store system shows. We sell more items in-store, than online. But I need to keep the online store's inventory accurate. Both lists have about 2500 rows that match, but one list has an extra 2500 rows.

I found the following which helps but copy's the matched value in row7 columnA sheetA to row? ColumnQ sheetB: excel vba macro to match cells from two different workbooks and copy and paste accordingly

Sub UpdateInventory()

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long
Dim d As Long

Application.ScreenUpdating = False

Set w1 = Workbooks("WorksheetA.xlsm").Worksheets("Sheet1")
Set w2 = Workbooks("WorksheetB.xlsm").Worksheets("Sheet1")

For Each c In w1.Range("A7", w1.Range("A" & Rows.Count).End(xlUp))
FR = 0
On Error Resume Next
FR = Application.Match(c, w2.Columns("A"), 0)
On Error GoTo 0
If FR <> 0 Then w2.Range("Q" & FR).Value = c.Offset(, 0)
Next c
Application.ScreenUpdating = True
End Sub

score 0 · Accepted Answer · answered Aug 28 '18 at 11:33

Please see below my modification to the VBA code. I have added a number of things here to help you diagnose where the code is going wrong. I believe it was relatively simple and the only functional parts of the code I corrected were:

(a) "FR = Application.Match(c.Value, w2.Columns("A"), 0)"

replaces

"FR = Application.Match(c,w2.Columns("A"), 0)"

(b) "w2.Range("Q" & FR).Value = w1.Range("D" & c.Row).Value"

replaces

"w2.Range("Q" & FR).Value = c.offset(,0)"

I have added debug.print lines that you can monitor in the immediate window after you run the macro for testing.

Sub UpdateInventory()

Debug.Print "Starting Sub: UpdateInventory"
Debug.Print "-----------------------------"

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long
Dim d As Long
Dim Workbook_A_Name, Workbook_B_Name, Worksheet_A_Name, Worksheet_B_Name As String

Debug.Print "Declared Variables"

'I added in these variable declarations to just neaten things up
Workbook_A_Name = "WorksheetA.xlsm" 'Online-Store File
Workbook_B_Name = "WorksheetB.xlsm" 'In-Store File
Worksheet_A_Name = "Sheet1" 'Online-Store File sheet name
Worksheet_B_Name = "Sheet1" 'In-Store File sheet name

Debug.Print "Set Variables"

Application.ScreenUpdating = False ' Good

Debug.Print "ScreenUpdating Off"

Set w1 = Workbooks(Workbook_A_Name).Worksheets(Worksheet_A_Name)
Set w2 = Workbooks(Workbook_B_Name).Worksheets(Worksheet_B_Name)

Debug.Print "Set Worksheets"

Debug.Print ""

For Each c In w1.Range("A7", w1.Range("A" & Rows.Count).End(xlUp))
    Debug.Print "Doing Line : " & c.AddressLocal & " in workbook: " & w1.Name
    FR = 0
    On Error Resume Next

    FR = Application.Match(c.Value, w2.Columns("A"), 0) 'added ".value" . 'This looks for the appropriate row number in Workbook B to copy data to
    Debug.Print "FR = " & FR
    On Error GoTo 0

    Debug.Print "Copying Matching Data from Column D in Workbook A to Column Q in Workbook B"
    If FR <> 0 Then
        Debug.Print "w2.Range(""Q"" & FR).AddressLocal = " & w2.Range("Q" & FR).AddressLocal
        Debug.Print "w1.Range(""D"" & c.Row).AddressLocal = " & w1.Range("D" & c.Row).AddressLocal
        Debug.Print "w1.Range(""D"" & c.Row).Value = " & w1.Range("D" & c.Row).Value
        w2.Range("Q" & FR).Value = w1.Range("D" & c.Row).Value 'change c.offset(,0)
    End If

Next c

Application.ScreenUpdating = True

Debug.Print "ScreenUpdating Off"

End Sub

copy values between sheets based on criteria using VB in excel

1 Answers1