CODEWITHSUNDEEP
vb.netvbaexcel
Jonathan Lim
Jonathan Lim

Reputation: 15

Searching from different workbook and copying values

I have 2 wb to_update_example_1 and purchasing_list

basically what I am trying to do is to a loop row by row on workbook to_update_example_1 if the same name is found to copy the a variable to the purchasing_list workbook.

However it keeps giving me error 91 at the searching portion and I would need an advice how do I write vVal2(which is the Qty) to Purchasing list workbook the column is just beside the found name so I tried to use active cell offset but didn't work too

any advice is appreciated thanks

Sub Macro1()

Application.ScreenUpdating = False

Dim x As Integer
Dim vVal1, vVal2 As String

Numrows = Range("A1", Range("A1").End(xlDown)).Rows.Count ' Set numrows = number of rows of data.
Range("A1").Select  ' Select cell a2.
For x = 1 To Numrows ' Establish "For" loop to loop "numrows" number of times.
    vVal1 = Cells(x, 8)
    vVal2 = Cells(x, 7)

    Windows("Purchasing List.xls").Activate

    ActiveSheet.Cells.Find(What:=vVal1, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row

    ''write to Qty cell beside the found name ActiveCell.Offset(0, -2) = vVal2
    Windows("To_update_example_1.xlsm").Activate

    ''''''''ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 68

Answers (2)

DisplayName
DisplayName

Reputation: 13386

Edited to account for OP's comment about where to search and write values

ShaiRado already told you where the flaw was

here's an alternative code

Option Explicit

Sub Macro1()
    Dim cell As Range, FindRng As Range

    Dim purchListSht As Worksheet
    Set purchListSht = Workbooks("Purchasing List.xls").Worksheets("purchaseData") '(change "purchaseData" to your actual "purchase" sheet name)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Workbooks("to_update_example_1").Sheets("SourceData") ' reference your "source" worksheet in "source" workbook (change "SourceData" to your actual "source" sheet name)
        For Each cell In .Range("H1", .Cells(.Rows.Count, 8).End(xlUp)).SpecialCells(xlCellTypeConstants) ' loop through referenced "source" sheet column "H" not empty cells
            Set FindRng = purchListSht.Columns("G").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns) ' try finding current cell content in "purchase" sheet column "G"
            If Not FindRng Is Nothing Then FindRng.Offset(, -2).Value = cell.Offset(, -1).Value ' if successful, write the value of the cell one column left of the current cell to the cell two columns to the left of found cell
        Next
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Upvotes: 1

Shai Rado
Shai Rado

Reputation: 33682

When using the Find function, it's recommended if you set a Range object to the Find result, and also prepare your code for a scenario that Find didn't find vVal1 in "Purchasing List.xls" workbook. You can achieve it by using the following line If Not FindRng Is Nothing Then.

Note: avoid using Select, Activate and ActiveSheet, instead fully qualify all your Objects - see in my code below (with comments).

Modified Code

Option Explicit

Sub Macro1()

Application.ScreenUpdating = False

Dim x As Long, Numrows As Long
Dim vVal1 As String, vVal2 As String
Dim PurchaseWb As Workbook
Dim ToUpdateWb As Workbook
Dim FindRng As Range

' set workbook object of "Purchasing List" excel workbook
Set PurchaseWb = Workbooks("Purchasing List.xls")

' set workbook object of "To_update_example_1" excel workbook
Set ToUpdateWb = Workbooks("To_update_example_1.xlsm")

With ToUpdateWb.Sheets("Sheet1") ' <-- I think you are trying to loop on "To_update_example_1.xlsm" file , '<-- change "Sheet1" to your sheet's name
    ' Set numrows = number of rows of data.
    Numrows = .Range("A1").End(xlDown).Row

    For x = 1 To Numrows ' Establish "For" loop to loop "numrows" number of times
        vVal1 = .Cells(x, 8)
        vVal2 = .Cells(x, 7)

        ' change "Sheet2" to your sheet's name in "Purchasing List.xls" file where you are looking for vVal1
        Set FindRng = PurchaseWb.Sheets("Sheet2").Cells.Find(What:=vVal1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns)
        If Not FindRng Is Nothing Then '<-- make sure Find was successful finding vVal1
            ' write to Qty cell beside the found name ActiveCell.Offset(0, -2) = vVal2
            ' Not sure eactly what you want to do now ???

        Else ' raise some kind of notification
            MsgBox "Unable to find " & vVal1, vbInformation
        End If
    Next x
End With

Application.ScreenUpdating = True

End Sub

Upvotes: 1

Related Questions