How to convert this If Error/VLookup to VBA

[kenny_g]

Hello,

I'm trying to write the following formula in VBA

=IFERROR(VLOOKUP($H5,Players!$B$1:$AB$1492,5,FALSE),0)

We use excel for a hockey pool, and each team page references the players page to retrieve the stats from many different columns. With these repetitive formula's in each cell, the workbook has become quite large. I'm hoping to write code to help alleviate some of the heavy lifting, and reduce the amount of in cell formulas

Thanks,

 

[offthelip]

Welcome to the forum,
The really powerful way of doing this is to use a varaint array and the dictionary object to load all the lookup data just once. Once the dictionary is loaded you can use it multiple times and it is very fast. You could run the load dictionary code just when the workbook is opened if the "players" sheet doesn't change. Otherwise you can run when a worksheet is activated. This will make it much faster than vlookup. I didn't know what columns you wanted copied but that is easily changed, I have assumed you have lot of values to look up starting in H5

Public dict As Object   ' these two variables must be at the top of the module
Public allarr As Variant                    ' and this one

Sub Loaddictionary()
lastrow = 1492
Set dict = CreateObject("scripting.dictionary")
With Worksheets("Players")
allarr = .Range(.Cells(1, 1), .Cells(lastrow, 28)) ' load all that data from player workshee into an array
End With
For i = 1 To lastrow
    If Not (dict.Exists(allarr(i, 2))) Then
       dict.Add allarr(i, 2), i           ' save the row index as the dictionary item
    End If
Next i
End Sub

Sub finddata()
lastdat = Cells(Rows.Count, "H").End(xlUp).Row
inarr = Range(Cells(1, 8), Cells(lastdat, 8))
outarr = Range(Cells(1, 10), Cells(lastdat, 18))
For i = 5 To lastdat
 rowno = dict(inarr(i, 1))
 If rowno > 0 Then
 For j = 1 To 8    ' I don't know which columns you want copied so I have copied A to H into J to Q
  outarr(i, j) = allarr(rowno, j)
 Next j
 End If
Next i
Range(Cells(1, 10), Cells(lastdat, 18)) = outarr

End Sub

 

[kenny_g]

Welcome to the forum,
The really powerful way of doing this is to use a varaint array and the dictionary object to load all the lookup data just once. Once the dictionary is loaded you can use it multiple times and it is very fast. You could run the load dictionary code just when the workbook is opened if the "players" sheet doesn't change. Otherwise you can run when a worksheet is activated. This will make it much faster than vlookup. I didn't know what columns you wanted copied but that is easily changed, I have assumed you have lot of values to look up starting in H5

Public dict As Object   ' these two variables must be at the top of the module
Public allarr As Variant                    ' and this one

Sub Loaddictionary()
lastrow = 1492
Set dict = CreateObject("scripting.dictionary")
With Worksheets("Players")
allarr = .Range(.Cells(1, 1), .Cells(lastrow, 28)) ' load all that data from player workshee into an array
End With
For i = 1 To lastrow
    If Not (dict.Exists(allarr(i, 2))) Then
       dict.Add allarr(i, 2), i           ' save the row index as the dictionary item
    End If
Next i
End Sub

Sub finddata()
lastdat = Cells(Rows.Count, "H").End(xlUp).Row
inarr = Range(Cells(1, 8), Cells(lastdat, 8))
outarr = Range(Cells(1, 10), Cells(lastdat, 18))
For i = 5 To lastdat
 rowno = dict(inarr(i, 1))
 If rowno > 0 Then
 For j = 1 To 8    ' I don't know which columns you want copied so I have copied A to H into J to Q
  outarr(i, j) = allarr(rowno, j)
 Next j
 End If
Next i
Range(Cells(1, 10), Cells(lastdat, 18)) = outarr

End Sub

Thanks for the quick response. I'll offer a little more context. The range each team sheet pulls data is between 5 & 64, with some blank spaces between. Column H(the actual player names) is where all other columns reference. Currently via formula, if I change the player name in cell H5 to another player listed in the players tab, it'll change all relevant information. And the players tab does get refreshed daily via an external query, so those values do change.

 

[Peter_SSs]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Trying to Convert IfError(Vlookup( formula to VBA
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[kenny_g]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Trying to Convert IfError(Vlookup( formula to VBA
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

Whoops, sorry about that. My apologies

 

[offthelip]

I don't think I can help you further without more details of which columns from Players sheet you want copied to which cells on the active sheet.
Am I correct in thinking that you only have one players name to lookup on the sheet?? i.e. the name in H5?? Do you have multiple sheets that you want this code on??

 

[kenny_g]

I don't think I can help you further without more details of which columns from Players sheet you want copied to which cells on the active sheet.
Am I correct in thinking that you only have one players name to lookup on the sheet?? i.e. the name in H5?? Do you have multiple sheets that you want this code on??

I tried to upload a mini sheet, but it kept on crashing with not responding message. So I've attached 2 screen shots of what a team page resembles. There are 10 identical pages(different sheets) representing the 10 different teams.
Columns A & H-Q reference the players page with a formula such as the one I mentioned earlier(except G5 and not H5) =IFERROR(VLOOKUP($G5,Players!$B$1:$AB$1492,5,FALSE),0)
Columns B-F reference the contracts page with formula =IFERROR(VLOOKUP($G5,Contracts'!$B$1:$K$399,6,FALSE),0)

 

[offthelip]

I have modified the code I have written to write some of the columns of data for you, Column A and columns F to K. this data is only from the player page, ( which is the only one you mentioned in your original post. A bit of requirements creep!!)
It is not clear where the other columns are supposed come from. Also the code only deals with rows 5 to 22 , I don't know what is going on below that.
Note I have been unable to test this because unfortunately you were not able to load your mini sheet. They do compile and both subs a very simple.
To get it to work with your contract page you need to duplicate the loaddictionary code using different variables for dict and alldata , e.g dictC and alldataC loaddictionaryC
Then add more code to the findata sub using the second dictionary to find the row number on the contracts page.
You must run the loadictionary code first but it only needs to be run once, this could be when you open the worksheet and when you update the players worksheet
updated findata code from your picture:

Sub finddata()
'lastdat = Cells(Rows.Count, "G").End(xlUp).Row
lastdat = 22
inarr = Range(Cells(1, 8), Cells(lastdat, 8))
outarr = Range(Cells(1, 1), Cells(lastdat, 18)) '  load all the existing data in column A to R
For i = 5 To lastdat
 rowno = dict(inarr(i, 1))
 If rowno > 0 Then
  outarr(i, 1) = allarr(rowno, 3) ' Age in to col A 1st column
 For j = 6 To 11    ' 
  outarr(i, j + 2) = allarr(rowno, j) ' Copy F to K from Players to H to M on team
 Next j
 ' columns N to O on the team page do not have correspnding headers on the player page
 ' ditto column T
 ' however they can be done in exactly the same way as above
 End If
Next i
Range(Cells(1, 1), Cells(lastdat, 18)) = outarr

End Sub

Note the loaddictionary code is unchanged

 

[kenny_g]

Appreciate all you effort, I'll give this a shot!