0
votes

I have two spreadsheets (wb1 and wb2). The goal is to select each value in column D of wb1, find the value in column C of wb2, then copy a range of cells (same row as the search value) back to wb1.

Here's the code I've managed to pull together thus far:

    Dim rng1 As Range, rng2 As Range
    Dim cell as Variant
    Dim cell_val as String    
    Dim wb1 as Workbook, wb2 as Workbook
    Dim sh1 as Worksheet, sh2 as Worksheet

    Sub Find_Copy_Paste()

    set wb1 = Workbooks.Open("c:\explicit\path\to\wb1.xlsm")  <---This fails    
    set wb2 = Workbooks.Open("c:\explicit\path\to\wb2.xlsm")  <---This fails

    Set sh1 = wb1.Open("Inventory")    
    set sh2 = wb2.Open ("Sheet1")

    set rng1 = wb1.sh1.Range("D6:D1702")
    set rng2 = wb2.sh2.Range("C2:C3132")

    For Each cell In rng1
        ActiveCell.Select
        cell_val = Selection.Copy
        Windows(wb2).Activate
        Cells.Find(What:=(cell_val), After:=ActiveCell, 
        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, 
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset (0,1).Range("A1:AH1").Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(wb1).Activate
        ActiveCell.Offset(0,1).Range("A1").Select
        ActiveSheet.Paste
        cell_val=""
    Next

    End Sub

Unfortunately, I'm hitting a challenge, and I suspect it has to do with two things: 1) wb1 and wb2 variables and how I've assigned them, and 2) the variable in the Cells.Find part of my code (but I'm still fairly new to VBA, so my suspicions might be way off).

1
Activate/Select ..OUCHAutomate This
set wb1 = Workbooks.Open("c:\explicit\path\to\wb1.xlsm") <---This fails - can you clarify? It fails only if you have wrong path.Dmitry Pavliv
All those set's should be proper case Set - any chance you've declared a variable called set somewhere in your code?Tim Williams
the set statements are all capitalized in the actual code (I just mistyped while trying to format in this window). The path to the files was copied/pasted straight from the properties of the file (so I know the paths are correct). Unfortunately, I'm getting a Run-time error '1004': Method 'Open' of object 'Workbooks' failed error message when I try to debug.user3388888
I've also attempted to take the .Open out of the picture (ie. Set wb1 = Workbooks("c:\explicit\path\to\file.xlsm") and I get Runtime Error 9: Subscript out of range.user3388888

1 Answers

1
votes

Try this below, I have simulated your goal with only 1 workbook. If the macro & path is not trusted, you may have issue opening the xlsm files. Here I only have one of them in ReadOnly mode (Workbook 2).

Sub Find_Copy_Paste()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim cell As Range, FoundCells As Range

    Set wb1 = Workbooks.Open(Filename:="c:\explicit\path\to\wb1.xlsm",ReadOnly:=False)
    Set wb2 = Workbooks.Open(Filename:="c:\explicit\path\to\wb2.xlsm",ReadOnly:=True)

    Set sh1 = wb1.Worksheets("Inventory")
    Set sh2 = wb2.Worksheets("Sheet1")

    Set rng1 = sh1.Range("D6:D1702")
    Set rng2 = sh2.Range("C2:C3132")

    For Each cell In rng1
        If Not IsEmpty(cell) Then
            Set FoundCells = rng2.Find(cell.Value)
            If Not FoundCells Is Nothing Then
                Debug.Print """" & cell.Value & """ found at " & FoundCell.Worksheet.Name & "!" & FoundCell.Address
                ' Copy Found cell to one column on right of cell being searched for
                FoundCells.Copy Destination:=cell.Offset(0, 1)
            End If
        End If
    Next
    Set rng1 = Nothing
    Set rng2 = Nothing
    Set sh1 = Nothing
    Set sh2 = Nothing
    Set wb1 = Nothing
    Set wb2 = Nothing
End Sub

There are many good place to start learning VBA, for Excel 2010, check out the Excel Developer Reference.