Vlookup in vba to find a reference which will be copy and pasted from one workbook to another

[balla506]

Hi,

I am stuck with this as I know a little vba but this is currently beyond my abilities. I basically am trying to have vba loop through a list of worksheets in the current workbook (WB1). The worksheet also exist on a different workbook (WB2-which is open). I need to use vlookup behind the scenes along with a custom function that returns the name of the sheet the cell is on. The vlookup will return for example

'[2014 Q1 Institutional.xlsm]Sheet1'!

<tbody>
</tbody>

and will combine this with an & and a range in vba. This is the section I want to copy from WB2 to the same range in WB1. Please Help!!! Thanks in advance to one smarter than me.

Sub test()

Dim found As Range
Dim ws As Worksheet
For Each ws In Worksheets
  With ws
    Select Case .Name
      Case "a","b","c"
   (Application.VLookup(Application.SheetName(B6), "Hierarchy!$Q$2:$R$100", 2, 0) & "E89:W90").value
    End Select
  End With
Next


End Sub

 

[Rosen]

While I am not entirely sure I understand what your trying to do, I can offer this, to use any worksheet function use WorksheetFunctions.<FUNCTIONNAME> (eg WorksheetFunctions.VLookup())

Also, you are cycling through the ActiveWorkbooks Sheets collection, generally that is alright if you explicitly state which workbook is active in the Workbooks collection, but if not you will have to come up with a way to validate which workbook you where looking at. I would suggest being more explicit by calling on the workbook's Sheets collection directly, (eg ThisWorkbook.Sheets, thought the ThisWorkbook reference is unnecessary as it it has presedence, that is, "For Each ws In Sheets" is always the same as "For Each ws In ThisWorkbook.Sheets").

I don't know if this will help, but here is some example code for copying data from one workbook to another with identical sheets:

Sub test()
    Dim ws As Worksheet
    Dim wb As Workbook
    
    ' Get our second workbook.
    Set wb = Workbooks("WB2")
    For Each ws In Sheets
        With ws
        
            ' Transfer data from WB1 to WB2
            wb.Sheets(.Name).Range("A1").Value = .Range("A1").Value
        End With
    Next ws
End Sub

If you provide more detail about what your trying to accomplish that would be helpful.


Hope this helps!

 

[balla506]

Rosen thanks for your help. I will try to better explain what I am trying to do. I have a master workbook with 20 different customer worksheets in it. I also have 6 different workbooks that contain some number of the 20 workbooks (each of the 20 are only in one of the files). I have added in the select case to make sure I can define which worksheets get looped through on the master as there are some worksheets in the master workbook that need not be included in the macro. I am trying to in vba do a vlookup of the sheetname from a hierarchy sheet in the master to return the file and sheet location of the data I want copied (ex.lookup for institutional returns '[2014 Q1 INST.xlsm]Institutional'!) and then pair that with the range I want (similar to an indirect function in excel). I will then copy this range and paste it in the master sheet and then loop to the next worksheet.

 

[Rosen]

I think I got it now...


So hierarchy looks something like this:

	A	B
1	Institutional	'[2014 Q1 INST.xlsm]Institutional'!
2	Cosmic	'[2014 Q2 LAST.xlsm]Cosmic'!
3	Tango	'[2014 Q1 INST.xlsm]Tango'!

<tbody>
</tbody>

Now you want to use VLOOKUP to return what is in this column B based on a parameter of what you might find in Column A. Then using some function (I will call Foo from now on) you will be able to get the cell address you want to copy into your master file's sheet of the same name for which you are pulling the data.

SSub Update()
    Dim ws As Worksheet
    Dim sRef As String
    
    ' So we loop through each sheet in the master
    For Each ws In Sheets
    
        ' Insure this is not a worksheet we do not want to update
        If Not IsInvalid(ws.Name) Then
            
            sRef = "=" & WorksheetFunction.VLookup(ws.Name, "A1:B20", 2, False)
            sRef = sRef & Foo
            ws.Range(Foo).Formula = sRef
        End If
    Next ws
End Sub
Function Foo() As String
    Foo = "some address"
End Function
Function IsInvalid(Name As String) As Boolean
    'needed
    If Name = "hierarchy" Then IsInvalid = True
    'example
    If Name = "Cosmic" Then IsInvalid = True
    'template
    'If Name = "" Then IsInvalid = True
End Function

Now, this code assumes that you want the information cell addresses on both sheets to match up.

Hope this helps!

 

[balla506]

Thanks so much for your help, Rosen. I like the use of invalid rather than having to list 50 sheets out spearately to loop through. The last part of this that I need to figure out is that Foo will be a couple ranges such as "A1:G1,G60:I60,etc." The copied range will also change based on cell G18. So if G18=Q1 then it should copy nothing. If G18=Q2 then it should copy a certain range such as "A1:G1,G60:I60,etc.", if G18=Q3 then it should copy "A1:G2,G60:I61,etc." This needs to be copied from the master and moved to the sheet in the file that we reference from sref in the same exact cells they appear on the master.

 

[Rosen]

Alright, I have more questions then answers this time:

(1) Are we trying to link information from the Other workbooks to the Master, the Master to the Others, or both?
(2) When you say "A1:G1,G60:I60,etc." are you saying under some condition it will return one of these or you need all these ranges to return?

Now assuming it is just Other workbooks to the Master file and that note that the GetAddress function (used to be called Foo) is just Pseudo code here is what I have for you so far. (had to make an adjustment to the Update sub as it assumed Foo (now GetAddress) only retuned a one cell reference):

Sub Update()
    Dim ws As Worksheet
    Dim sRef As String, sAddress As String
    
    ' So we loop through each sheet in the master
    For Each ws In Sheets
    
        ' Ensure this is not a worksheet we do not want to update
        If Not IsInvalid(ws.Name) Then
            
            Dim cell As Range
            sAddress = GetAddress(ws)
            'Ensure we are working with a valid range.
            If Not sAddress = "NoAddress" And Not sAddress = "Unknown" Then
                ' cycle through each cell and create link.
                For Each cell In ws.Range(sAddress)
                    sRef = "=" & WorksheetFunction.VLookup(ws.Name, "A1:B20", 2, False)
                    sRef = sRef & cell.Address
                    cell.Formula = sRef
                Next cell
            End If
        End If
    Next ws
End Sub
Function GetAddress(ws As Worksheet) As String
    ' Assumes G18 in on the Hierarchy sheet of the master file.
    If Sheets("Hierarchy").Range("G18").Value = ws.Range("Q1").Value Then
        GetAddress = "NoAddress"
    ElseIf Sheets("Hierarchy").Range("G18").Value = ws.Range("Q2").Value Then
        GetAddress = "A1:G1,G60:I60,etc."
    ElseIf Sheets("Hierarchy").Range("G18").Value = ws.Range("Q3").Value Then
        GetAddress = "A1:G2,G60:I61,etc."
    Else
        ' No match; handle this occurance here.
        GetAddress = "Unknown"
    End If
End Function
Function IsInvalid(Name As String) As Boolean
    'needed
    If Name = "hierarchy" Then IsInvalid = True
    'example
    If Name = "Cosmic" Then IsInvalid = True
    'template
    'If Name = "" Then IsInvalid = True
End Function

 

[balla506]

Answers for Questions
(1) We are talking from the separate files and linking to the master. Basically we have information loaded into multiple ranges (ex:A1:B10, A:30:B35) and I need to pull this info and paste it into the exact same locations on the master file. I then have a macro that will split the master worksheets into the separate files that will later be used for the next quarters master file after they are updated by personel.

(2) Based on the cell value from Hierarchy (ie. Q2) I need it to paste multiple ranges to the master sheet. For example there are rows 1,2,3 which correspond to Q1, Q2, Q3. There are also rows 4,5,6 that also corresponde with Q1,Q2,Q3. If the cell on hierachy says Q1 I need it only to copy a range from portion 1,4 for Q2 it has to copy 1,2,4,5.

I hope this helps explain. I am sorry I was not more clear before. This will be very useful thanks so much for all your help.

 

[balla506]

Hi Rosen,

Hope I answered your questions here. If someone else has any help please let me know. Thanks.

 

[Rosen]

Sorry for taking so long to respond, I am still not 100% sure I know what your trying to do, but this sample code will setup links based on the Q value in the reference to a number of rows (as supplied and extrapolated from your answer (2)) into your master.

Sub Update()
    Dim ws As Worksheet, Rows() As Long, i As Long
    Dim sRef As String, sAddress As String, cell As Range
    
    ' So we loop through each sheet in the master
    For Each ws In Sheets
    
        ' Ensure this is not a worksheet we do not want to update
        If Not IsInvalid(ws.Name) Then
            
            Rows = GetAddress(ws)
            For i = LBound(Rows) To UBound(Rows) Step 1
            
                'Ensure we are working with a valid range.
                sAddress = Rows(i) & ":" & Rows(i)
                If Not sAddress = "0:0" Then
                
                    ' cycle through each cell and create link.
                    For Each cell In ws.Range(sAddress)
                    
                        sRef = "=" & WorksheetFunction.VLookup(ws.Name, "A1:B20", 2, False)
                        sRef = sRef & cell.Address
                        cell.Formula = sRef
                    Next cell
                End If
            Next i
        End If
    Next ws
End Sub
Function GetAddress(ws As Worksheet) As Long()
    Dim Result() As Long
    sRef = WorksheetFunction.VLookup(ws.Name, "A1:B20", 2, False)
    If VBA.Strings.Mid(sRef, 8, 2) = "Q1" Then
        ReDim Result(1 To 2) As Long
        Result(1) = 1
        Result(2) = 4
    ElseIf VBA.Strings.Mid(sRef, 8, 2) = "Q2" Then
        ReDim Result(1 To 4) As Long
        Result(1) = 1
        Result(2) = 2
        Result(3) = 4
        Result(4) = 5
    ElseIf VBA.Strings.Mid(sRef, 8, 2) = "Q3" Then
        ReDim Result(1 To 6) As Long
        Result(1) = 1
        Result(2) = 2
        Result(1) = 3
        Result(2) = 4
        Result(3) = 5
        Result(4) = 6
    Else
    End If
    GetAddress = Result
End Function
Function IsInvalid(Name As String) As Boolean
    'needed
    If Name = "hierarchy" Then IsInvalid = True
    'example
    If Name = "Cosmic" Then IsInvalid = True
    'template
    'If Name = "" Then IsInvalid = True
End Function

I hope this helps!

 

[balla506]

Hey,

I wish I could send you a file to look at here. I have D17:W17 is the Forecast Q1 for product A D18:W18 is for Q2 Product A. D19:W19 is for Q3 Product A. Also below that I have D41:W41 is the Forecast Q1 for product B D42:W42 is for Q2 Product B. D43:W43 is for Q3 Product B. This continues in these columns for a couple more products. So based on the cell value in one cell on the Hierarchy tab. I need to pull the previous quarters (ex. if I am doing the template for Q3 I need to pull the ranges for Q1-Q2 for previous forecasts for all products. If Q2 I only need to pull in Q1 for all the products. I also need to pull Columns Y:AG from the previous Quarters file (this is the vlookup to get us to the file name and location) and paste them in no matter what quarter we are in as this is a continuing commentary section. I am trying to narrow this down as much as possible for you. I think the code above pulls whole rows in the get address section. I know this is prob getting annoying. Sorry for that. Thanks for all your help.