Solved: Faster than Vlookup

[stapuff]

On sheet1 AF2:AF35000 I have either a zip code or blank cell.
On sheet2 A2:A42000 I have a zip code list in numerical order with the latitude and longitude for the zip code in column B & C.

I have attempted a Vlookup to solve my problem but it is way, way too slow.

I am looking to basically vlookup each cell in sheet1 AF2:AF35000, match to sheet2 A2:A42000 then have the offset value returned to AG & AH of sheet1.

I hope this makes sense.

Any suggestions would be appreciated.

Thanks,

Kurt

[Justinlabenne]

Could you attach a sample workbook? I just want to see how you have this structured and where the results needs to be. It would be a bit easier to look at what you have already than to replicate your workbook on my end, and have the solution not be "ready to use".

Possible?

[stapuff]

I appreciate your response back.

If you look at the sample wb sheet1 column a,b,c are static data (result of Get External Data). The rest is results of vlookup's. Column d & e are the request of my post.

The vlookup works, however, way too slow to be functional. Sheet2 in reality has 42000 rows to check and sheet1 runs between 10000 to 35000 rows at any one given time.

Looking at the possibility of a "Find" macro. Something I thought of on the way home from work last night.

Still looking for your thoughts on the matter.

Thanks,

Kurt

[stapuff]

I have created a macro to complete the task I posted. Any help on making it faster would be greatly appreciated. Currently takes 1.5 minutes to run.

Thanks,

Kurt

Sub Button1_Click()
Dim Rng As Range
Range("AH3:AM25000").ClearContents
Set Rng = Sheets("Sheet2").Columns("A:C")
With Sheets("Sheet1")
For Each cell In Range("AG3:AG25000")
On Error Resume Next
If cell.Value > " " Then
.Range("AH" & cell.Row).Value = _
WorksheetFunction.VLookup(cell, Rng, 2, False)
.Range("AI" & cell.Offset(0, 1).Row).Value = _
WorksheetFunction.VLookup(cell, Rng, 3, False)
End If
Next cell
End With
Set Rng = Sheets("Sheet3").Columns("A:B")
With Sheets("Sheet1")
For Each cell In Range("AJ3:AJ25000")
On Error Resume Next
If cell.Offset(0, -1).Value <> "" Then
.Range("AJ" & cell.Row).Value = _
WorksheetFunction.VLookup(cell.Offset(0, -35), Rng, 2, False)
End If
Next cell
End With
Set Rng = Sheets("Sheet2").Columns("A:C")
With Sheets("Sheet1")
For Each cell In Range("AJ3:AJ25000")
On Error Resume Next
If cell.Value > " " Then
.Range("AK" & cell.Row).Value = _
WorksheetFunction.VLookup(cell, Rng, 2, False)
.Range("AL" & cell.Offset(0, 1).Row).Value = _
WorksheetFunction.VLookup(cell, Rng, 3, False)
End If
Next cell
End With
Range("AM3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""", """",IF(RC[-3]=RC[-6],"""",3963*ACOS(COS(RADIANS(90-(RC[-5]*24)))*" & _
"COS(RADIANS(90-(RC[-2]*24)))+SIN(RADIANS(90-(RC[-5]*24)))*" & _
"SIN(RADIANS(90-(RC[-2]*24)))*COS(RADIANS(24*(RC[-4]-RC[-1]))))))"
Range("AM3").Select
Selection.AutoFill Destination:=Range("AM3:AM25000"), Type:=xlFillDefault
Range("AM3:AM25000").Select
Range("AN3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]="""","""",IF(SUM(RC[-1]+RC[-1]*10%)<451,1,IF(AND(SUM(RC[-1]+" & _
"RC[-1]*10%)>450,SUM(RC[-1]+RC[-1]*10%)<900),2,3)))"
Range("AN3").Select
Selection.AutoFill Destination:=Range("AN3:AN25000"), Type:=xlFillDefault
Range("AN3:AN25000").Select
End Sub