Consulting

Results 1 to 5 of 5

Thread: find/retrieve price from closed WB and copy to current workbook

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    14
    Location

    find/retrieve price from closed WB and copy to current workbook

    active worksheet has item numbers in column A

    workbook "pricing" has the same item numbers in A and a price in H
    (some of the item numbers are duplicated in "pricing" so I need the search for each item number to stop as soon as it is first found)

    also the workbook "pricing" may be already opened by a different user.... so read only?

    I need the macro to start in A1 of active worksheet and search column A in "pricing" for the item number if found copy H to H of the active sheet.

    item number may not be found

    The following code I don't prefer because it copies the final instance of price number.
    It also isn't closing "pricing" after macro ran

    I've seen vlookup or match but am unable to adapt code myself


    HTML Code:
    Sub pricetheinvoice()
    
         Dim cl As Range   Dim dic As Object   Dim ws1 As Worksheet, ws2 As Worksheet
    
         Application.ScreenUpdating = False
    
         Set ws2 = ThisWorkbook.ActiveSheet
    
         Workbooks.Open Filename:="C:\FileServer\CompanyDocs\My Excel\Copy of Pricing.xls"    
         Set wb1 = ActiveWorkbook    
         Set ws1 = ActiveSheet         
         Set dic = CreateObject("scripting.dictionary")   
    
         For Each cl In ws1.Range("A1", ws1.Range("A" & Rows.Count).End(xlUp))      
              dic(cl.Value) = cl.Offset(, 7).Value   
         Next cl   
    
         For Each cl In ws2.Range("A1", ws2.Range("A" & Rows.Count).End(xlUp))      
              cl.Offset(, 7).Value = dic(cl.Value)   
         Next cl
    
     End Sub

  2. #2
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    327
    Location
    Hi lostinvb!
    Sub pricetheinvoice()
         Dim cl As Range
         Dim dic As Object
         Dim ws1 As Worksheet, ws2 As Worksheet
         Application.ScreenUpdating = False
         Set ws2 = ThisWorkbook.ActiveSheet
         Workbooks.Open Filename:="C:\FileServer\CompanyDocs\My Excel\Copy of Pricing.xls", ReadOnly:=True
        Set wb1 = ActiveWorkbook
         Set ws1 = ActiveSheet
         Set dic = CreateObject("scripting.dictionary")
         For Each cl In ws1.Range("A1", ws1.Range("A" & Rows.Count).End(xlUp))
              If Not dic.exists(cl.Value) Then dic(cl.Value) = cl.Offset(, 7).Value
         Next cl
         wb1.Close False
        For Each cl In ws2.Range("A1", ws2.Range("A" & Rows.Count).End(xlUp))
              cl.Offset(, 7).Value = dic(cl.Value)
         Next cl
        Application.ScreenUpdating = True
     End Sub
    Last edited by 大灰狼1976; 04-11-2019 at 10:45 PM.

  3. #3
    VBAX Regular
    Joined
    Mar 2019
    Posts
    14
    Location
    sorry for the long pause in reply. This works great. However, I would like to move the macro to my personal workbook. (I did so but then nothing happens when run).
    I think it is ( I know it is) looking at the activesheet in the personal workbook not the activesheet I am running the macro on? The name of the open wb that I run the macro on always changes.

  4. #4
    VBAX Regular
    Joined
    Mar 2019
    Posts
    14
    Location
    answered my own question .... changed the following and it seemed to work:

    Set ws2 = ThisWorkbook.ActiveSheet

    to

    Set ws2 = ActiveSheet

  5. #5
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    327
    Location
    Yes, it needs to be revised according to the actual situation.


    --Okami

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •