Macro very slow and becomes unresponsive or am I impatient

ghrek

Active Member
Joined
Jul 29, 2005
Messages
273
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.

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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,813
Office Version
  1. 2010
Platform
  1. Windows
One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.

So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 11000 rows it is much quicker to load the 11000 lines into a variant array ( one worksheet access), and then usethe variant array to load the collections. I have modified your code to change it to using a couplke of variant arrays so it should be at least 1000 times faster. and I mean one thousand times faster !!


I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
the code is untest so probably needs some debugging:
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
' find start address of ID column
tablestart = Range("Table1").Row
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 = i + tablestart ' 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
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 = i + tablestart
        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
Range(Tableadd).Offset(DU1.Range, 4) = DU1.Report


'DU1.Range.Offset(0, 4) = DU1.Report
Next

'report 2nd group
For Each DU1 In colB
Range(Table2add).Offset(DU1.Range, 4) = DU1.Report
Next
End Sub
 

ghrek

Active Member
Joined
Jul 29, 2005
Messages
273
Many thanks for that.

at this line
VBA Code:
 [CODE=vba] Set DU1.Range = i + tablestart ' this is just storing the row numberin the table

I get runtime error 424 object required??


Any ideas?
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,813
Office Version
  1. 2010
Platform
  1. Windows
Youi probably need to change the definition of the DUI object so that you aren't storing a range but an index ( long) which is all you need, The range object is a very large object and takes masses of resources to store, so you should avoid using them if you can. You certainly don't need it for this because you can use the range row number and columnber number instaed to writethe report out.
 

ghrek

Active Member
Joined
Jul 29, 2005
Messages
273

ADVERTISEMENT

Im sorry thats right above my head. Im completely basic on macros
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,813
Office Version
  1. 2010
Platform
  1. Windows
At the top of your code you define du1 as c_dataunit, you need to find and modify the code in that module
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,548
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

In other words, you declared du1 = c_dataunit. What exactly is a c_dataunit. It does not exist. Excel will not compile this code because there is no such object called c_dataunit that is defined by Excel.
 

ghrek

Active Member
Joined
Jul 29, 2005
Messages
273
I dont know what a C-Dataunit is .Is that something that Im missing from the sheet as dont think it should be there.
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,548
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Quoted from your original post...

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
 

ghrek

Active Member
Joined
Jul 29, 2005
Messages
273
Apologies for sounding thick but I would say thats the data sources im using TAB & WFJ?
 

Watch MrExcel Video

Forum statistics

Threads
1,129,876
Messages
5,638,788
Members
417,052
Latest member
Noobest

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top