Consulting

Results 1 to 4 of 4

Thread: VBA help on pulling data from an external workbook

  1. #1

    VBA help on pulling data from an external workbook

    I have two files attached to similarly represent what I am working with since I cannot share them. The code is below used in book2.xlsm

    I am using the "copy data" macro in book2.xlsm to pull data from text.xlsx and it works well for the "data entry" sheet on test.xlsx.

    I want this to work for the sample 1, sample 2, etc sheets as well though so that I am able to pull the integration values. However, the name of the sample sheet (sample 1 in text.xlsx) will change with the name of the sample and thus needs to be dynamic. It will match the sample name in book2 though. How can I achieve this?

    Additionally, how can I change the code for the external workbook so that I can reference cell A1 for the file name instead of having to code in a new file name every time? This will be a very routine operation I will do daily with new file names for samples I process.


    Sub copydata() 
    Dim rw As Long, x As Range 
    Dim extwbk As Workbook, twb As WorkbookSet twb = ThisWorkbook
    Set extwbk = Workbooks.Open("/Users/username/desktop/test.xlsx")
    Set x = extwbk.Worksheets("Data entry").Range("A1:GZ400")
    
    With twb.Sheets("Sheet1")
    
        For rw = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
            .Cells(rw, 2) = Application.VLookup(.Cells(rw, 1).Value2, x, 11, False)
        Next rw
    
    End With
    
    With twb.Sheets("sheet1")
    
             For rw = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
            .Cells(rw, 3) = Application.VLookup(.Cells(rw, 1).Value2, x, 12, False)
        Next rw
    
    End With
    
        extwbk.Close savechanges:=False [COLOR=var(--black-800)]End Sub[/COLOR]
    Any help/guidance will be greatly appreciated!
    Attached Files Attached Files

  2. #2
    Are the attached true representations of your actual workbooks?

  3. #3
    I don't know if you're up to cleaning up your attachments, but if you do, this should work.
    The two attached files are "cleaned up", everything more consistent like names, capitalization, spacing, same amount of sheets as names etc.
    Workbook "test (6).xlsx" needs to be saved to the desktop.
    Sub Maybe()
    Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet
    Dim i As Long, j As Long
    Application.ScreenUpdating = False
    Set wb1 = ThisWorkbook
    Set sh1 = wb1.Sheets("Sheet1")
    
    
    On Error Resume Next
        Set wb2 = Workbooks(sh1.Range("A1").Value)
        If Err Then Set wb2 = Workbooks.Open(CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & sh1.Range("A1").Value)
    On Error GoTo 0
    
    
        For i = 4 To sh1.Cells(Rows.Count, 1).End(xlUp).Row
            sh1.Cells(i, 1).Offset(, 1).Resize(, 2).Value = wb2.Sheets("Data entry").Columns(1).Find(sh1.Cells(i, 1), , , 1).Offset(, 10).Resize(, 2).Value
                For j = 3 To 7
                     sh1.Cells(i, 1).Offset(, j).Value = wb2.Sheets(sh1.Cells(i, 1).Value).Columns(4).Find(sh1.Cells(i, 1).Offset(3 - i, j), , , 1).Offset(, 4).Value
                Next j
        Next i
        wb2.Close False
    Application.ScreenUpdating = False
    End Sub
    Attached Files Attached Files

  4. #4
    Did the suggestions work?

Posting Permissions

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