Speed up index match vba in long worksheet

[denmccue]

This macro works. Thank you for your previous help
My worksheet starts out with 1000+ rows at start of month, and the For/Next loop takes a while to run through the sheet. Is there a way to speed it up?

Sub SiteNum()

Dim LastRow As Long
Dim x As Long
Dim y As Long

LastRow = Cells(Rows.Count, 3).End(xlUp).Row

For y = 2 To LastRow

Range("H" & y) = "=Index(" & Range("$P$2:$P$284").Address(False, False) & " , Match(" & Range("E" & y).Address(True, False) & " ," & Range("$O$2:$O$284").Address(True, True) & ", 0))"

Next y
End Sub

 

[offthelip]

Try this which is the first "easy" level of speeding up, all I have done is removed the loop through the 49 cells which writes 49 times to the worksheet by using a variant array for the output as well.
If this is not sufficient, then two things are possible one is as you suggest just updating the single row, but I don't expect that to much faster than this version. The other way to make it faster is to define Dic as public variable and load the dictionary just once when the workhseet is activated, this could be significant if "Personnel info" is very large

Sub test()
' this shows hte use of a dictionary to copy a value to a mathcing worksheet
   Dim Ary As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
 
   Set Dic = CreateObject("Scripting.dictionary")
   With Worksheets("Personnel Info")
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    Ary = .Range(.Cells(1, 1), .Cells(lastrow, 3)) ' load all of the data from the Personnel sheet in a variatn array
   End With
   For i = 1 To UBound(Ary, 1)
      Dic(Ary(i, 1)) = Ary(i, 3)  ' load all the data into the dictionary. with value the company name
   Next i
   With Worksheets("Daily POB")
    inarr = .Range(.Cells(3, 3), .Cells(52, 4)) ' load C3:D52 into variant array
      For i = 1 To UBound(inarr, 1)
         inarr(i, 2) = Dic(inarr(i, 1)) 'this matches the value given by tyhe index C1.value in the dictionary
      Next i
     .Range(.Cells(3, 3), .Cells(52, 4)) = inarr ' write C3:D52 from variant array

   End With
End Sub

Note untested!!

 

[offthelip]

Here is the my second idea which loads the dictionary when the workhseet is activated:
in the workhseet code:

Private Sub Worksheet_Activate()
Call loaddic
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Range("C3:C52"), Target) Is Nothing Then
  Call test
 End If
End Sub

In the module code:

Public Dic   ' this statement must be rigt at the top of the module
Sub loaddic()
   Set Dic = CreateObject("Scripting.dictionary")
   With Worksheets("Personnel Info")
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    Ary = .Range(.Cells(1, 1), .Cells(lastrow, 3)) ' load all of the data from the Personnel sheet in a variatn array
   End With
   For i = 1 To UBound(Ary, 1)
      Dic(Ary(i, 1)) = Ary(i, 3)  ' load all the data into the dictionary. with value the company name
   Next i

End Sub

Sub test()
' this shows hte use of a dictionary to copy a value to a mathcing worksheet
   Dim Ary As Variant
   Dim i As Long
 
   With Worksheets("Daily POB")
    inarr = .Range(.Cells(3, 3), .Cells(52, 4)) ' load C3:D52 into variant array
      For i = 1 To UBound(inarr, 1)
         inarr(i, 2) = Dic(inarr(i, 1)) 'this matches the value given by tyhe index C1.value in the dictionary
      Next i
     .Range(.Cells(3, 3), .Cells(52, 4)) = inarr ' write C3:D52 from variant array

   End With
End Sub

 

[sloany101]

Here is the my second idea which loads the dictionary when the workhseet is activated:
in the workhseet code:

Private Sub Worksheet_Activate()
Call loaddic
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Range("C3:C52"), Target) Is Nothing Then
  Call test
 End If
End Sub

In the module code:

Public Dic   ' this statement must be rigt at the top of the module
Sub loaddic()
   Set Dic = CreateObject("Scripting.dictionary")
   With Worksheets("Personnel Info")
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    Ary = .Range(.Cells(1, 1), .Cells(lastrow, 3)) ' load all of the data from the Personnel sheet in a variatn array
   End With
   For i = 1 To UBound(Ary, 1)
      Dic(Ary(i, 1)) = Ary(i, 3)  ' load all the data into the dictionary. with value the company name
   Next i

End Sub

Sub test()
' this shows hte use of a dictionary to copy a value to a mathcing worksheet
   Dim Ary As Variant
   Dim i As Long
 
   With Worksheets("Daily POB")
    inarr = .Range(.Cells(3, 3), .Cells(52, 4)) ' load C3:D52 into variant array
      For i = 1 To UBound(inarr, 1)
      [COLOR=rgb(247, 218, 100)] [/COLOR][COLOR=rgb(97, 189, 109)] inarr(i, 2) = Dic(inarr(i, 1)) 'this matches the value given by tyhe index C1.value in the dictionary[/COLOR]
      Next i
     .Range(.Cells(3, 3), .Cells(52, 4)) = inarr ' write C3:D52 from variant array

   End With
End Sub

the bold underlined code is throwing run time error 13 : type mismatch error in debug mode (changed line of code throwing error to green font color)

 

[offthelip]

I think the problem is that you made a change on the worksheet before the dictionary was loaded so DIc is undefined. What you need to do is select any other sheet and then select the Daily POB sheet, it is the action of activating the Daily POB sheet which loads the dictionary just the once. Since you can't change row 3 to 52 without activating the sheet this is always going to be sufficient
So select another sheet , then select Daily POB and try again

 

[sloany101]

I think the problem is that you made a change on the worksheet before the dictionary was loaded so DIc is undefined. What you need to do is select any other sheet and then select the Daily POB sheet, it is the action of activating the Daily POB sheet which loads the dictionary just the once. Since you can't change row 3 to 52 without activating the sheet this is always going to be sufficient
So select another sheet , then select Daily POB and try again

Nope still showing type mismatch , if i hover over the debugged code with my cursor it shows Dic(inarr(i, 1))=<Type Mismatch> (thats when i hover my cursor over the "Dic" portion of that line of code)

 

[offthelip]

try this modificatoin which checks that the name is exists in the dictionary

Sub test()
' this shows hte use of a dictionary to copy a value to a mathcing worksheet
   Dim Ary As Variant
   Dim i As Long
  
   With Worksheets("Sheet2")
    inarr = .Range(.Cells(3, 3), .Cells(52, 4)) ' load C3:D52 into variant array
      For i = 1 To UBound(inarr, 1)
         If (Dic.Exists(inarr(i, 1))) Then
         inarr(i, 2) = Dic(inarr(i, 1)) 'this matches the value given by tyhe index C1.value in the dictionary
      Else
         inarr(i, 2) = inarr(i, 1) & " Not Found"
      end if
      Next i
     .Range(.Cells(3, 3), .Cells(52, 4)) = inarr ' write C3:D52 from variant array

   End With
End Sub

 

[sloany101]

try this modificatoin which checks that the name is exists in the dictionary

Sub test()
' this shows hte use of a dictionary to copy a value to a mathcing worksheet
   Dim Ary As Variant
   Dim i As Long
 
   With Worksheets("Sheet2")
    inarr = .Range(.Cells(3, 3), .Cells(52, 4)) ' load C3:D52 into variant array
      For i = 1 To UBound(inarr, 1)
         If (Dic.Exists(inarr(i, 1))) Then
         inarr(i, 2) = Dic(inarr(i, 1)) 'this matches the value given by tyhe index C1.value in the dictionary
      Else
         inarr(i, 2) = inarr(i, 1) & " Not Found"
      end if
      Next i
     .Range(.Cells(3, 3), .Cells(52, 4)) = inarr ' write C3:D52 from variant array

   End With
End Sub

the line of code

If (Dic.Exists(inarr(i, 1))) Then

causes run time error 424 - object required when debug

 

[offthelip]

Have selected another sheet and back again??
also you probably need to put this in the workbook code:

Private Sub Workbook_Open()
Call loaddic
End Sub

 

[sloany101]

Have selected another sheet and back again??

Yes ..... i have done every thing you have instructed i reset it selected a diifferent sheet and back to POB before initiating the code again and error 424 keeps coming up

 

[sloany101]

Have selected another sheet and back again??
also you probably need to put this in the workbook code:

Private Sub Workbook_Open()
Call loaddic
End Sub

alright got it to trigger buuuuut it crashes excel ......