Macro very slow and becomes unresponsive or am I impatient

[ghrek]

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.

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

 

[offthelip]

try this version which does save the range in dui.range , this will make it run a bit slower than my original version but still a lot faster than the original, but it does save you needing to change the definition of your custom objects:

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
' find start address of ID column
tablestart = Range("Table1").Row
tablecol = Range("Table1").Column
ttable = Range("Table1") '
Tableadd = Range("Table1").Address

For i = 1 To UBound(ttable, 1)
    If Not IsEmpty(ttable(i, 2)) Then
   
        Set DU1 = New c_DataUnit
        DU1.f1 = ttable(i, 2)
        DU1.DataType = ttable(i, 1)
        DU1.f2 = ttable(i, 3)
        DU1.f3 = ttable(i, 4)
        DU1.f4 = ttable(i, 5)
        Set DU1.Range = Range(Cells(i + tablestart, tablecol + 1), Cells(i + tablestart, tablecol + 1)) ' this is just storing the row numberin the table
        colA.Add DU1
    End If
Next i



'collect second group
Set colB = New Collection
table2start = Range("Table2").Row
table2col = Range("Table2").Column
ttable2 = Range("Table2") '
Table2add = Range("Table2").Address
For i = 1 To UBound(ttable2, 1)
    If Not IsEmpty(ttable2(i, 2)) Then
   
        Set DU2 = New c_DataUnit
        DU2.f1 = ttable2(i, 2)
        DU2.DataType = ttable2(i, 1)
        DU2.f2 = ttable2(i, 3)
        DU2.f3 = ttable2(i, 4)
        DU2.f4 = ttable2(i, 5)
        Set DU2.Range = Range(Cells(i + table2start, table2col + 1), Cells(i + table2start, table2col + 1)) '
        colB.Add DU2
    End If
Next i

'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

'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

 

[offthelip]

c_dataunit, it is is in the original code that you posted. I don't know what it is, when run it on my machine I just get an error message "User defined type not defined". Looking at the code that you posted it is obviously an object that stores a number of variables and produces an output called report. The definition of this object is in your system somewhere or if it isn't this code will never work. What are you expecting this code to so? It doesn't look complicated , what are you expecting in the report? It might be simpler to rewrite all the code if you can't find c_dataunit