Hi
I have the following macro that runs and the wheel keeps spinning. After 5 mins it still doing the same and when I click on the screen again it comes up un responsive.
Am I not allowing enough time or is there anyway the macro can be changed to show what lines it checking as it goes along so I know its running. It is trying to check 11,000 rows.
End Sub
I have the following macro that runs and the wheel keeps spinning. After 5 mins it still doing the same and when I click on the screen again it comes up un responsive.
Am I not allowing enough time or is there anyway the macro can be changed to show what lines it checking as it goes along so I know its running. It is trying to check 11,000 rows.
VBA Code:
Sub Test()
Dim colA As Collection
Dim colB As Collection
Dim DU1 As c_DataUnit
Dim DU2 As c_DataUnit
Dim r As Range
Dim i As Long
Dim n As Long
'collect first group
Set colA = New Collection
For Each r In Range("Table1[ID]")
If Not IsEmpty(r) Then
Set DU1 = New c_DataUnit
DU1.f1 = r
DU1.DataType = r.Offset(0, -1)
DU1.f2 = r.Offset(0, 1)
DU1.f3 = r.Offset(0, 2)
DU1.f4 = r.Offset(0, 3)
Set DU1.Range = r
colA.Add DU1
End If
Next
'collect second group
Set colB = New Collection
For Each r In Range("Table2[ID]")
If Not IsEmpty(r) Then
Set DU2 = New c_DataUnit
DU2.f1 = r
DU2.DataType = r.Offset(0, -1)
DU2.f2 = r.Offset(0, 1)
DU2.f3 = r.Offset(0, 2)
DU2.f4 = r.Offset(0, 3)
Set DU2.Range = r
colB.Add DU2
End If
Next
'get instance number of each data unit
'ie compare group to itself
For i = colA.Count To 1 Step -1
Set DU1 = colA(i)
For n = i - 1 To 1 Step -1
Set DU2 = colA(n)
If DU1.IsMatch(DU2) Then
DU1.Instance = DU1.Instance + 1
End If
Next n
Next i
'same for 2nd group
For i = colB.Count To 1 Step -1
Set DU1 = colB(i)
For n = i - 1 To 1 Step -1
Set DU2 = colB(n)
If DU1.IsMatch(DU2) Then
DU1.Instance = DU1.Instance + 1
End If
Next n
Next i
'compare each data unit 1st grp to 2nd grp
For Each DU1 In colA
For Each DU2 In colB
If DU1.IsMatch(DU2) Then
DU1.Matches = DU1.Matches + 1
End If
Next DU2
Next DU1
'compare each data unit 2nd grp to 1st grp
For Each DU1 In colB
For Each DU2 In colA
If DU1.IsMatch(DU2) Then
DU1.Matches = DU1.Matches + 1
End If
Next DU2
Next DU1
'clear report section of tables
Range("Table1[Result]").ClearContents
Range("Table2[Result]").ClearContents
'report 1st group
For Each DU1 In colA
DU1.Range.Offset(0, 4) = DU1.Report
Next
'report 2nd group
For Each DU1 In colB
DU1.Range.Offset(0, 4) = DU1.Report
Next
End Sub