Steviemac
New Member
- Joined
- May 24, 2021
- Messages
- 14
- Office Version
- 2019
- Platform
- Windows
Hi there, first time poster, long time lurker
Hoping some kind soul can speed up this macro with a light speed modification
The data to check (InputData) is replaced many times at this part of the process and at the rate the InputData comes in is
proving to be a real bottleneck, the macro works fine, it's just that it takes 16 seconds to run each time, which is too long
Hopefully there is a better faster way (maybe a macro rewrite!)
Data is held in two data sets, both 5 columns across
InputData set is 56 rows (variable)
TaskPercentComplete set is 2000 rows (variable)
Every row in the 'InputData' table is compared with Each row in turn in the 'TaskPercentComplete' table
for matches - it only has to record whether there is a match of 3 values and/or a match of 4 values
Any help is very much appreciated
Thanks Ste
Hoping some kind soul can speed up this macro with a light speed modification
The data to check (InputData) is replaced many times at this part of the process and at the rate the InputData comes in is
proving to be a real bottleneck, the macro works fine, it's just that it takes 16 seconds to run each time, which is too long
Hopefully there is a better faster way (maybe a macro rewrite!)
Data is held in two data sets, both 5 columns across
InputData set is 56 rows (variable)
TaskPercentComplete set is 2000 rows (variable)
Every row in the 'InputData' table is compared with Each row in turn in the 'TaskPercentComplete' table
for matches - it only has to record whether there is a match of 3 values and/or a match of 4 values
Any help is very much appreciated
Thanks Ste
VBA Code:
Sub TaskPercentages()
Application.ScreenUpdating = False
Dim InputData As Long
Sheets("TaskPercentComplete").Range("J3:L10000").ClearContents
InputData = 2
Do While Not Sheets("TaskPercentComplete").Cells(InputData, 46).Value = ""
TaskDataOutput = 3
Do While Not Sheets("TaskPercentComplete").Cells(TaskDataOutput, 3).Value = ""
Dim rngA As Range: Set rngA = Range("C" & TaskDataOutput & ":G" & TaskDataOutput)
Dim rngB As Range: Set rngB = Range("AT" & InputData & ":AX" & InputData)
If Evaluate("SUMPRODUCT(COUNTIF(" & rngA.Address & "," & rngB.Address & "))") = 4 Then
Sheets("TaskPercentComplete").Cells(TaskDataOutput, 11).Value = "80%"
End If
If Evaluate("SUMPRODUCT(COUNTIF(" & rngA.Address & "," & rngB.Address & "))") = 3 Then
Sheets("TaskPercentComplete").Cells(TaskDataOutput, 10).Value = "60%"
End If
TaskDataOutput = (TaskDataOutput + 1)
Loop
InputData = (InputData + 1)
Loop
'nextonwardmacro
End Sub