I only looked at COUNT_DODGY_DOCS
The first tow subs seems to run pretty quick, but this one was really slow since you were doing what seemed to be a lot of unnecessary processing (extra rows, all cells in a Table, etc.)
I used 2 arrays for speed, and I've found for me at least I make less mistakes if I use A1:something-something instead of B2:H2000 since cells counts/indices are relative to the over-arching Range (i.e. Cells(1,1) in B2:H2000 is B2)
I just want to avoid silly mistakes
Option Explicit Sub COUNT_DODGY_DOCS() Dim Table2 As Range, Table3 As Range Dim Dept_Clm As Long Dim rowLast2 As Long, rowLast3 As Long, rowInactive As Long, n As Long Dim sDoc As String Dim aryCol4 As Variant, aryCol104 As Variant With Sheet2 ' Doc Register sheet rowLast2 = .Cells(.Rows.Count, 2).End(xlUp).Row Set Table2 = .Cells(1, 1).Resize(rowLast2, 7) End With With Sheet3 ' Cross Ref Docs sheet rowLast3 = .Cells(.Rows.Count, 4).End(xlUp).Row Set Table3 = .Cells(1, 1).Resize(rowLast3, 104) aryCol4 = Application.WorksheetFunction.Transpose(Table3.Columns(4)) aryCol104 = Application.WorksheetFunction.Transpose(Table3.Columns(104)) End With Dept_Clm = 7 For rowInactive = 2 To rowLast2 sDoc = Table2.Cells(rowInactive, 2).Value n = 0 On Error Resume Next n = Application.WorksheetFunction.Match(sDoc, aryCol4, 0) On Error GoTo 0 If n = 0 Then Table2.Cells(rowInactive, Dept_Clm) = "" Else Table2.Cells(rowInactive, Dept_Clm) = aryCol104(n) End If Next rowInactive MsgBox "Complete" End Sub




Reply With Quote