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]

Can you post you full code from the pob sheet and the module.

 

[sloany101]

Can you post you full code from the pob sheet and the module.

will do , when it triggers i get a run time error 1004 - method 'range' of object'_worksheet' failed error and then it crashes will post code in a second

 

[sloany101]

This is in the module

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)
         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

THIS is what i have in the Daily POB sheet 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

 

[offthelip]

that is exactly what I have got and it worked when I tested it with my test data. Can you post your data for both worksheets using the XL2BB addin, because there must be something about your data that I haven't understood. See this post for the XL2BB add:
XL2BB - Excel Range to BBCode
I don't need all of your data only a sample, and if it is secure can you try to create a insecure version you can post

 

[sloany101]

that is exactly what I have got and it worked when I tested it with my test data. Can you post your data for both worksheets using the XL2BB addin, because there must be something about your data that I haven't understood. See this post for the XL2BB add:
XL2BB - Excel Range to BBCode

So i cant download that on this work computer , but i actually got it working by adding Application.EnableEvents = False / True at the beginning and end of the module "Sub test() , and its working wonderfully now in stead of it inputting the company data in column D3:D52 i actually need the data put in column F3:F52 trying to figure out where and what i need to change to do this.

Below is exactly how i have the module right now

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
   Application.EnableEvents = False
    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)
         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)
      End If
      Next i
     .Range(.Cells(3, 3), .Cells(52, 4)) = inarr ' write C3:D52 from variant array
   End With
   Application.EnableEvents = True
End Sub

 

[offthelip]

Sorry about that I should have thought it,
this will write the output to col F

Sub test2()
With Worksheets("Daily POB")
    inarr = .Range(.Cells(3, 3), .Cells(52, 1)) ' load C3:C52 into variant array
    outarr = .Range(.Cells(3, 6), .Cells(52, 6)) ' load F3:F52 into variant array
      For i = 1 To UBound(inarr, 1)
         If (Dic.Exists(inarr(i, 1))) Then
         outarr(i, 1) = Dic(inarr(i, 1)) 'this matches the value given by tyhe index C1.value in the dictionary
      Else
         outarr(i, 1) = inarr(i, 1) & " Not Found"
      End If
      Next i
     .Range(.Cells(3, 6), .Cells(52, 6)) = outarr ' write F3:F52 from variant array

   End With
End Sub

 

[sloany101]

Thank you very much after some tweaking i was able to apply it to other areas , thanks again this is pretty nifty

 

[offthelip]

I am pleased we got there in the end,