Good Morning,
I am a beginner in VBA and am trying to improve performance of my doc control register. The current code works fine, however when this is updated to have data return value on a different worksheet, or values summed onto a different worksheet it takes 5 to 8 mins to process all info. The example included is significantly reduced, we have about 2000 lines that need to be processed.
The goal of the code is to check all documents on our 'Cross-Referencing Docs' sheet that have other docs referenced within them and check these doc #'s against our 'Doc Register' list, and then colour code if 'Inactive' or do not exist (Bad ID). Currently, after completing this check, the code does a count on the total number of Inactive or Bad ID docs per row and returns the value at the end of the row, however we want the result to be on the 'Doc Register' sheet.
Below is the code we used the have the value's return on the Doc Register worksheet instead of the Cross-Referencing sheet - We have also attempted to use a Sum code and then calling that after completion of the count, also below.
Sub Check_For_Inactive_References() '=====declare variables====================================================================== Dim Inactive_Reference_Count As Integer Dim BadDocID_Count As Integer Dim ColumnRange As Range Dim StartRow As Integer Dim EndRow As Integer Dim StartColumn As String Dim Inactive_Total_Column As String Dim Bad_ID_Total_Column As String '=====initialise variables===================================================================== StartRow = 2 EndRow = 2000 StartColumn = "I" EndColumn = "Z" Inactive_Total_Column = "G" 'IF WE USE THE SUM FUNCTION, THIS WILL BE "CY" Bad_ID_Total_Column = "H" 'IF WE USE THE SUM FUNCTION, THIS WILL BE "CZ" MsgBox ("Checking for totals against each Doc ID, please wait") '=====scan through all rows in the sheet and then execute the "for each" function within this loop for each row=== Do Until StartRow > EndRow 'keep looping until the counter gets up to the last row '=====Check the row the script is up to for number of inactive and bad ID documents=========== For Each ColumnRange In Sheet3.Range(StartColumn & StartRow & ":" & EndColumn & StartRow) Select Case ColumnRange.Interior.ColorIndex 'check the color of the current cell Case Is = 3 'if the current cell is RED Inactive_Reference_Count = Inactive_Reference_Count + 1 'Increase inactive counter for the current row by 1 Case Is = 7 'if the current cell is MAGENTA BadDocID_Count = BadDocID_Count + 1 'increase bad doc ID counter for the current row by 1 Case Else 'do nothing End Select Next ColumnRange Sheet2.Range(Inactive_Total_Column & StartRow) = Inactive_Reference_Count 'write inactive count total against the row in sheet - IF WE USE THE SUM FUNCTIONS THIS WILL BE SHEET3 Sheet2.Range(Bad_ID_Total_Column & StartRow) = BadDocID_Count 'write bad doc id count total against the row in sheet - IF WE USE THE SUM FUNCTIONS THIS WILL BE SHEET3 Inactive_Reference_Count = 0 'once values are written to the sheet, reset them back to 0 ready for next row BadDocID_Count = 0 'once values are written to the sheet, reset them back to 0 ready for next row '=============================================================================================== StartRow = StartRow + 1 'increment to the next row and repeat the loop again Loop MsgBox ("Complete") End Sub
SUM OF COUNT:
Any help would be appreciated.Sub COUNT_DODGY_DOCS() On Error Resume Next Dim Count_Inactive_Row As Long Dim Dept_Clm As Long Table1 = Sheet2.Range("B2:H2000") Table2 = Sheet3.Range("D2:CZ2000") Count_Inactive_Row = Sheet2.Range("G2").Row Dept_Clm = Sheet2.Range("G2").Column For Each cl In Table1 Sheet2.Cells(Count_Inactive_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 100, False) Count_Inactive_Row = Count_Inactive_Row + 1 Next cl End Sub
Thanks