Setting up a Vlookup from an array

[DataBlake]

Hi all,
So i have 6 sheets (and growing) that i have multiple vlookups that reference all 6 sheets an example of this would be

=IF(Unknown!B2="new",IFERROR(VLOOKUP(Unknown!A2,Sheet1!$1:$1048576,1,FALSE),IFERROR(VLOOKUP(Unknown!A2,Sheet2!$1:$1048576,1,FALSE),IFERROR(VLOOKUP(Unknown!A2,Sheet3!$1:$1048576,1,FALSE),
IFERROR(VLOOKUP(Unknown!A2,Sheet4!$1:$1048576,1,FALSE),IFERROR(VLOOKUP(Unknown!A2,Sheet5!$1:$1048576,1,FALSE),"err"))))),"err")

I would instead like it to be

=IF(Unknown!B2="new",IFERROR(VLOOKUP(Unknown!A2,SHEETARRAY...)

I am unsure of how to make an array/name for all 6 sheets and get the vlookup to reference said array/name.
If its possible it will eliminate the nested if statements that will eventually reach their limit as well as causing less user entered mistakes.

if thats only possible through VBA thats more than fine with me.

Any help would be greatly appreciated

 

[DataBlake]

Re: Possibly just array?

which column in sheets 1 to 6 is the part number you are trying to match in, or could it be in any column?
Is there only one match for the partnumber or could there be matches on more than one sheet?
Do you want the search to all sheets apart from the "sheetinfo" sheet in the workbook.?
How many rows on the sheetinfo worksheet do you want matches donw ( all rows with data in column A?)
Do you really need to search 1048576 rows?
The way I would do this is to load every sheet in the workbook into variant arrays , then copy these into a threee dimension variant array, and just loop through all three dimensions to do the matches
since I don't use vlookup I don't know what :

[COLOR=#333333]VLOOKUP(Unknown!A2,Sheet2!$1:$1048576,17,FALSE)[/COLOR]

does without looking through the documentation. Is this looking at all columns on sheet2?

part numbers will always be in column A (which is why the nested vlookup works for me right now)
if it doesn't make a difference i don't care if it loops through all sheets but it would seem like a waste of time. Sheets 1-6 are the only ones that have part numbers to search.
BUT i would like to be able to add sheets in the future. so if you want to look for a match through all of them thats fine instead.
I use lastrow with my vba codes so no idon't need to search all 1048576 just A:A & lastRow (specifically the lastRow in "Unknown")
the part about the three dimension arrays is literal Chinese to me, but that is probably what i want.
no that vlookup looks for the first column in the range (since its all columns its A:A) and returns the 17th column

^ hopefully that helps

 

[offthelip]

Re: Possibly just array?

this is my effort at doing what you describe using variant arrays, :

Sub test()
Dim shtnam(1 To 6) As String


Dim bigarray()
shtnam(1) = "Sheet1"
shtnam(2) = "Sheet2"
shtnam(3) = "Sheet3"
shtnam(4) = "Sheet4"
shtnam(5) = "Sheet5"
shtnam(6) = "Sheet6"
 maxrows = 0
Dim lastrow(1 To 6) As Long
 For i = 1 To 6
 
  With Worksheets(shtnam(i))
   lastrow(i) = .Cells(Rows.Count, "A").End(xlUp).Row
   If lastrow(i) > maxrows Then
    maxrows = lastrow(i)
   End If
  End With
 Next i




' redefine   3 D array , 1 to 6 sheets, 1 to maxrows , 1 to 18 columns
ReDim bigarray(1 To 6, 1 To maxrows, 1 To 18)
 For i = 1 To 6
 
    With Worksheets(shtnam(i))
     inarr = Range(.Cells(1, 1), .Cells(maxrows, 18))
    End With
  ' copy to big aray
    For j = 1 To maxrows
     For k = 1 To 18
      bigarray(i, j, k) = inarr(j, k)
     Next k
    Next j
   Next i
'We now have all the lookup sheets loaded into the bigarray
' select the "sheet info " sheet, I am not sure whether this is called "Sheetinfo" or "Unknown"
Worksheets("sheetinfo").Select
 lastrowa = Cells(Rows.Count, "A").End(xlUp).Row
 ' pick up all the data currntly in the worksheet. ( I am assuming there are not equations in the worksheet , if there are this needs to be
 'slightly different)
 ' column 32 is column AF
 inarr = Range(Cells(1, 1), Cells(lastrowa, 32))
' now do the quadruple loop
 ' i assume the matches you are looking for start in row 2
  For rowno = 2 To lastrowa
  found = False
  If inarr(rowno, 1) <> "" Then
    For i = 1 To 6
     If found Then Exit For
     For j = 1 To maxrows
     If found Then Exit For
      For k = 1 To 18
       
        If inarr(rowno, 1) = bigarray(i, j, 1) Then
         ' we have found a match between the column A so copy the data
         
          inarr(rowno, 2) = bigarray(i, j, 1) ' A
          inarr(rowno, 12) = bigarray(i, j, 1) 'A
          inarr(rowno, 5) = bigarray(i, j, 16) 'P
          inarr(rowno, 11) = bigarray(i, j, 2) 'B
          inarr(rowno, 13) = bigarray(i, j, 5) 'E
          inarr(rowno, 14) = bigarray(i, j, 6) 'F
          inarr(rowno, 15) = bigarray(i, j, 8) 'H
          inarr(rowno, 16) = bigarray(i, j, 9) 'I
          inarr(rowno, 17) = bigarray(i, j, 10) 'J
          inarr(rowno, 18) = bigarray(i, j, 11) 'K
          inarr(rowno, 25) = bigarray(i, j, 15) 'O
          inarr(rowno, 27) = bigarray(i, j, 17) 'Q
          inarr(rowno, 30) = bigarray(i, j, 12) 'L
          inarr(rowno, 32) = bigarray(i, j, 18) 'R
          ' you didn't specify for multiple matches so we exit the search for this value
          found = True
          Exit For
        End If
      Next k
     Next j
    Next i
   End If
  Next rowno
  ' write the array back to the worksheet
 Range(Cells(1, 1), Cells(lastrowa, 32)) = inarr
 
End Sub

 

[DataBlake]

Re: Possibly just array?

this is my effort at doing what you describe using variant arrays, :

Sub test()
Dim shtnam(1 To 6) As String


Dim bigarray()
shtnam(1) = "Sheet1"
shtnam(2) = "Sheet2"
shtnam(3) = "Sheet3"
shtnam(4) = "Sheet4"
shtnam(5) = "Sheet5"
shtnam(6) = "Sheet6"
 maxrows = 0
Dim lastrow(1 To 6) As Long
 For i = 1 To 6
 
  With Worksheets(shtnam(i))
   lastrow(i) = .Cells(Rows.Count, "A").End(xlUp).Row
   If lastrow(i) > maxrows Then
    maxrows = lastrow(i)
   End If
  End With
 Next i




' redefine   3 D array , 1 to 6 sheets, 1 to maxrows , 1 to 18 columns
ReDim bigarray(1 To 6, 1 To maxrows, 1 To 18)
 For i = 1 To 6
 
    With Worksheets(shtnam(i))
     inarr = Range(.Cells(1, 1), .Cells(maxrows, 18))
    End With
  ' copy to big aray
    For j = 1 To maxrows
     For k = 1 To 18
      bigarray(i, j, k) = inarr(j, k)
     Next k
    Next j
   Next i
'We now have all the lookup sheets loaded into the bigarray
' select the "sheet info " sheet, I am not sure whether this is called "Sheetinfo" or "Unknown"
Worksheets("sheetinfo").Select
 lastrowa = Cells(Rows.Count, "A").End(xlUp).Row
 ' pick up all the data currntly in the worksheet. ( I am assuming there are not equations in the worksheet , if there are this needs to be
 'slightly different)
 ' column 32 is column AF
 inarr = Range(Cells(1, 1), Cells(lastrowa, 32))
' now do the quadruple loop
 ' i assume the matches you are looking for start in row 2
  For rowno = 2 To lastrowa
  found = False
  If inarr(rowno, 1) <> "" Then
    For i = 1 To 6
     If found Then Exit For
     For j = 1 To maxrows
     If found Then Exit For
      For k = 1 To 18
       
        If inarr(rowno, 1) = bigarray(i, j, 1) Then
         ' we have found a match between the column A so copy the data
         
          inarr(rowno, 2) = bigarray(i, j, 1) ' A
          inarr(rowno, 12) = bigarray(i, j, 1) 'A
          inarr(rowno, 5) = bigarray(i, j, 16) 'P
          inarr(rowno, 11) = bigarray(i, j, 2) 'B
          inarr(rowno, 13) = bigarray(i, j, 5) 'E
          inarr(rowno, 14) = bigarray(i, j, 6) 'F
          inarr(rowno, 15) = bigarray(i, j, 8) 'H
          inarr(rowno, 16) = bigarray(i, j, 9) 'I
          inarr(rowno, 17) = bigarray(i, j, 10) 'J
          inarr(rowno, 18) = bigarray(i, j, 11) 'K
          inarr(rowno, 25) = bigarray(i, j, 15) 'O
          inarr(rowno, 27) = bigarray(i, j, 17) 'Q
          inarr(rowno, 30) = bigarray(i, j, 12) 'L
          inarr(rowno, 32) = bigarray(i, j, 18) 'R
          ' you didn't specify for multiple matches so we exit the search for this value
          found = True
          Exit For
        End If
      Next k
     Next j
    Next i
   End If
  Next rowno
  ' write the array back to the worksheet
 Range(Cells(1, 1), Cells(lastrowa, 32)) = inarr
 
End Sub

Thank you for the quick response
I am going to test this out

'We now have all the lookup sheets loaded into the bigarray
' select the "sheet info " sheet, I am not sure whether this is called "Sheetinfo" or "Unknown"
Worksheets("SheetInfo").Select
 lastrowa = Cells(Rows.Count, "A").End(xlUp).Row

Sheet info is where the matching data is going to be pasted
Unknown contains the list of part numbers that we are matching to sheets 1-6

 

[DataBlake]

Re: Possibly just array?

Thank you for the quick response
I am going to test this out

'We now have all the lookup sheets loaded into the bigarray
' select the "sheet info " sheet, I am not sure whether this is called "Sheetinfo" or "Unknown"
Worksheets("SheetInfo").Select
 lastrowa = Cells(Rows.Count, "A").End(xlUp).Row

Sheet info is where the matching data is going to be pasted
Unknown contains the list of part numbers that we are matching to sheets 1-6

I changed

Worksheets("Unknown").Select

Yes so this works as intended except for the results need to go into "Sheetinfo"
excellent code!

 

[DataBlake]

Re: Possibly just array?

Yes so this works as intended

It seems to be getting stuck when some of the sheets are blank
is there a workaround for that?
Its that or when i have too much data, but so far every time i've run it with any shtnam(i) being empty it becomes permanently unresponsive.

 

[offthelip]

Re: Possibly just array?

In my solution there is no error checking for anything I was trying to show a way of solving the problem . It is fairly obvious that if you try and load a range from a worksheet with a blank name, excel is going to struggle to do it.
in fact if any typo causes the text in shtnam be a non existent worksheet the code will hang up. So the only way to really get round this is to check that the name does exist (once) and then check at various points through the code where it is critical that the worksheet really does exist.
I have modified the code to do this and marked up each change with New code , end new code
There are all sorts of other possible errors you might get . e.g such a blank rows on the unknown sheet which could cause errors . You need to work out what error checking you need to put in bring the code up to the level of resilience that you need.
for my personal use I often don't bother about any error checking, I just correct the data or ignore it. For customers use I would try to make it unbreakable, on other occasions it is in between

I have also selected the sheetinfo sheet just before the last write statement which will write the results out to the sheetinfo sheet.

Sub test()
Dim shtnam(1 To 6) As String
Dim sheetexists(1 To 6) As Boolean


Dim bigarray()
shtnam(1) = "Sheet1"
shtnam(2) = "Sheet2"
shtnam(3) = "Sheet3"
shtnam(4) = "Sheet4"
shtnam(5) = "Sheet5"
shtnam(6) = "Sheet6"
 maxrows = 0
Dim lastrow(1 To 6) As Long
 For i = 1 To 6
  ' new code
     For Each Sheet In Worksheets
        If shtname(i) = Sheet.Name Then
            sheetexists(i) = True
            Exit For
        End If
    Next Sheet
 
    If sheetexists(i) Then
' end new code
  With Worksheets(shtnam(i))
   lastrow(i) = .Cells(Rows.Count, "A").End(xlUp).Row
   If lastrow(i) > maxrows Then
    maxrows = lastrow(i)
   End If
  End With
  ' new code
   End If
  ' end new code
 Next i








' redefine   3 D array , 1 to 6 sheets, 1 to maxrows , 1 to 18 columns
ReDim bigarray(1 To 6, 1 To maxrows, 1 To 18)
 For i = 1 To 6
'new code
    If sheetexists(i) Then
' end new code
 
    With Worksheets(shtnam(i))
     inarr = Range(.Cells(1, 1), .Cells(maxrows, 18))
    End With
  ' copy to big aray
    For j = 1 To maxrows
     For k = 1 To 18
      bigarray(i, j, k) = inarr(j, k)
     Next k
    Next j
  ' new code
   End If
  ' end new code
   
   Next i
'We now have all the lookup sheets loaded into the bigarray
' select the "sheet info " sheet, I am not sure whether this is called "Sheetinfo" or "Unknown"
Worksheets("Unknown").Select
 lastrowa = Cells(Rows.Count, "A").End(xlUp).Row
 ' pick up all the data currntly in the worksheet. ( I am assuming there are not equations in the worksheet , if there are this needs to be
 'slightly different)
 ' column 32 is column AF
 inarr = Range(Cells(1, 1), Cells(lastrowa, 32))
' now do the quadruple loop
 ' i assume the matches you are looking for start in row 2
  For rowno = 2 To lastrowa
  found = False
  If inarr(rowno, 1) <> "" Then
    For i = 1 To 6
    'new code
    If sheetexists(i) Then
   ' end new code


     If found Then Exit For
     For j = 1 To maxrows
     If found Then Exit For
      For k = 1 To 18
       
        If inarr(rowno, 1) = bigarray(i, j, 1) Then
         ' we have found a match between the column A so copy the data
         
          inarr(rowno, 2) = bigarray(i, j, 1) ' A
          inarr(rowno, 12) = bigarray(i, j, 1) 'A
          inarr(rowno, 5) = bigarray(i, j, 16) 'P
          inarr(rowno, 11) = bigarray(i, j, 2) 'B
          inarr(rowno, 13) = bigarray(i, j, 5) 'E
          inarr(rowno, 14) = bigarray(i, j, 6) 'F
          inarr(rowno, 15) = bigarray(i, j, 8) 'H
          inarr(rowno, 16) = bigarray(i, j, 9) 'I
          inarr(rowno, 17) = bigarray(i, j, 10) 'J
          inarr(rowno, 18) = bigarray(i, j, 11) 'K
          inarr(rowno, 25) = bigarray(i, j, 15) 'O
          inarr(rowno, 27) = bigarray(i, j, 17) 'Q
          inarr(rowno, 30) = bigarray(i, j, 12) 'L
          inarr(rowno, 32) = bigarray(i, j, 18) 'R
          ' you didn't specify for multiple matches so we exit the search for this value
          found = True
          Exit For
        End If
      Next k
     Next j
  ' new code
   End If
  ' end new code
    
    Next i
   End If
  Next rowno
  ' write the array back to the worksheet
  ' write the data to the sheetinfo sheet by selecting it
  'new code
  Worksheets("sheetinfo").Select
  ' end new code
 Range(Cells(1, 1), Cells(lastrowa, 32)) = inarr
 
End Sub

 

[DataBlake]

Re: Possibly just array?

In my solution there is no error checking for anything I was trying to show a way of solving the problem . It is fairly obvious that if you try and load a range from a worksheet with a blank name, excel is going to struggle to do it.
in fact if any typo causes the text in shtnam be a non existent worksheet the code will hang up. So the only way to really get round this is to check that the name does exist (once) and then check at various points through the code where it is critical that the worksheet really does exist.
I have modified the code to do this and marked up each change with New code , end new code
There are all sorts of other possible errors you might get . e.g such a blank rows on the unknown sheet which could cause errors . You need to work out what error checking you need to put in bring the code up to the level of resilience that you need.
for my personal use I often don't bother about any error checking, I just correct the data or ignore it. For customers use I would try to make it unbreakable, on other occasions it is in between

I have also selected the sheetinfo sheet just before the last write statement which will write the results out to the sheetinfo sheet.

Sub test()
Dim shtnam(1 To 6) As String
Dim sheetexists(1 To 6) As Boolean


Dim bigarray()
shtnam(1) = "Sheet1"
shtnam(2) = "Sheet2"
shtnam(3) = "Sheet3"
shtnam(4) = "Sheet4"
shtnam(5) = "Sheet5"
shtnam(6) = "Sheet6"
 maxrows = 0
Dim lastrow(1 To 6) As Long
 For i = 1 To 6
  ' new code
     For Each Sheet In Worksheets
        If shtname(i) = Sheet.Name Then
            sheetexists(i) = True
            Exit For
        End If
    Next Sheet
 
    If sheetexists(i) Then
' end new code
  With Worksheets(shtnam(i))
   lastrow(i) = .Cells(Rows.Count, "A").End(xlUp).Row
   If lastrow(i) > maxrows Then
    maxrows = lastrow(i)
   End If
  End With
  ' new code
   End If
  ' end new code
 Next i








' redefine   3 D array , 1 to 6 sheets, 1 to maxrows , 1 to 18 columns
ReDim bigarray(1 To 6, 1 To maxrows, 1 To 18)
 For i = 1 To 6
'new code
    If sheetexists(i) Then
' end new code
 
    With Worksheets(shtnam(i))
     inarr = Range(.Cells(1, 1), .Cells(maxrows, 18))
    End With
  ' copy to big aray
    For j = 1 To maxrows
     For k = 1 To 18
      bigarray(i, j, k) = inarr(j, k)
     Next k
    Next j
  ' new code
   End If
  ' end new code
   
   Next i
'We now have all the lookup sheets loaded into the bigarray
' select the "sheet info " sheet, I am not sure whether this is called "Sheetinfo" or "Unknown"
Worksheets("Unknown").Select
 lastrowa = Cells(Rows.Count, "A").End(xlUp).Row
 ' pick up all the data currntly in the worksheet. ( I am assuming there are not equations in the worksheet , if there are this needs to be
 'slightly different)
 ' column 32 is column AF
 inarr = Range(Cells(1, 1), Cells(lastrowa, 32))
' now do the quadruple loop
 ' i assume the matches you are looking for start in row 2
  For rowno = 2 To lastrowa
  found = False
  If inarr(rowno, 1) <> "" Then
    For i = 1 To 6
    'new code
    If sheetexists(i) Then
   ' end new code


     If found Then Exit For
     For j = 1 To maxrows
     If found Then Exit For
      For k = 1 To 18
       
        If inarr(rowno, 1) = bigarray(i, j, 1) Then
         ' we have found a match between the column A so copy the data
         
          inarr(rowno, 2) = bigarray(i, j, 1) ' A
          inarr(rowno, 12) = bigarray(i, j, 1) 'A
          inarr(rowno, 5) = bigarray(i, j, 16) 'P
          inarr(rowno, 11) = bigarray(i, j, 2) 'B
          inarr(rowno, 13) = bigarray(i, j, 5) 'E
          inarr(rowno, 14) = bigarray(i, j, 6) 'F
          inarr(rowno, 15) = bigarray(i, j, 8) 'H
          inarr(rowno, 16) = bigarray(i, j, 9) 'I
          inarr(rowno, 17) = bigarray(i, j, 10) 'J
          inarr(rowno, 18) = bigarray(i, j, 11) 'K
          inarr(rowno, 25) = bigarray(i, j, 15) 'O
          inarr(rowno, 27) = bigarray(i, j, 17) 'Q
          inarr(rowno, 30) = bigarray(i, j, 12) 'L
          inarr(rowno, 32) = bigarray(i, j, 18) 'R
          ' you didn't specify for multiple matches so we exit the search for this value
          found = True
          Exit For
        End If
      Next k
     Next j
  ' new code
   End If
  ' end new code
    
    Next i
   End If
  Next rowno
  ' write the array back to the worksheet
  ' write the data to the sheetinfo sheet by selecting it
  'new code
  Worksheets("sheetinfo").Select
  ' end new code
 Range(Cells(1, 1), Cells(lastrowa, 32)) = inarr
 
End Sub

you're the best thank you.
i have workarounds in mind for the blank sheet and the data i work with in consistent enough that i won't need much error checking.
thank you again for helping