Macro hangs on big data sheet

[jackal764u]

Hi,
I need help with a macro that works perfectly,
but when data in sheet increases to thousands of rows, it hangs (unresposive with grayed out screen).
The macro was modified/created by 'Fluff' (Thanks again!).
My additions & alterations are between "Start of My test code here" and "End of my test code"
and where referenses to Nary2 are made, also all comments are mine.

Your help is appreciated.

Sub AddCategories3() 'When changing cols just edit .range refs in "" commas
Application.ScreenUpdating = False
   Dim Ary As Variant, Nary As Variant, Nary2 As Variant    ' Nary=Cells K2 to N (MoneyData). Ary=Cells D2 to G (KW). Nary2=Cells D2 to I (MoneyData)
   Dim r As Long, i As Long, j As Long

   With Sheets("Keywords")
      Ary = .Range("D2", .Range("G" & Rows.Count).End(xlUp)).Value2     ' Value2 Uses real values that are not formatted i.e. date format
   End With
   With Sheets("MoneyData")
      If MsgBox("Reset IDs before running new search?", vbYesNo, "Reset") = vbYes Then .Range("K2:N" & .Rows.Count).ClearContents
      Nary = .Range("I2:N" & .Range("I" & Rows.Count).End(xlUp).Row)    'All Cells from K2 to N in MoneyData
      Nary2 = .Range("D2:I" & .Range("I" & Rows.Count).End(xlUp).Row)    'All Cells from D2 to I in MoneyData
   End With

   For r = 1 To UBound(Nary)    ' Nary = "I2:N" From Memo Col in (MoneyData)
        For i = 1 To UBound(Ary)  ' Ary =  "D2:G" From Payee Col in (KW)
            If Ary(i, 4) <> "" And InStr(1, Nary(r, 1), Ary(i, 4), vbTextCompare) Then     '  If Cells are not empty Then
               Nary(r, 3) = Ary(i, 1)  'Nary(r, Col K) = Ary(i, Col D) Correct payee from keywords sheet used
               Nary(r, 4) = Ary(i, 2)  'Nary(r, Col L) = Ary(i, Col E) Correct category from keywords sheet used
               Nary(r, 5) = Ary(i, 3)  'Nary(r, Col M) = Ary(i, Col F) Correct subcategory from keywords sheet used
               Nary(r, 6) = Ary(i, 4)  'Nary(r, Col N) = Ary(i, Col G) keyword used to categorize from keywords sheet
        Exit For   'my optional commenting out
             End If
''  Start of My test code here
        For j = r To UBound(Nary2) ' Nary2 = "D2:I" Memo Col D to Col I
             If Nary2(j, 6) = "" Then     ' does all @ once, I need line by line
'               Nary(r, 1) = "MData Memo is Empty"   'uncommented = keyword sheet, commented out = lines below, r, 1 stays empty
                Nary(r, 3) = Nary2(j, 1)  'Nary(r, Col K) = Nary2(j, Col D) Correct payee from Col D
                Nary(r, 4) = Nary2(j, 4)  'Nary(r, Col L) = Nary2(j, Col G) Correct category from Col G
                Nary(r, 5) = Nary2(j, 5)  'Nary(r, Col M) = Nary2(j, Col H) Correct subcategory from Col H
                Nary(r, 6) = Nary2(j, 6)  'Nary(r, Col N) = Nary2(j, Col I) keyword used to categorize from Col I
        Exit For
              End If  ' if commented out, runs through entire sheet, not just empty memo rows
        Next j
''  End of my test code
        Next i
   Next r
   Sheets("MoneyData").Range("I2").Resize(UBound(Nary), 6).Value = Nary 
   Sheets("MoneyData").Range("D2").Resize(UBound(Nary2), 6).Value = Nary2 
Application.ScreenUpdating = True
End Sub

 

[Marc L]

Hi,​

​

it's what happens when using Excel instead of any database software which could be a hundred times faster !​

​

So under Excel the VBA procedure does not really hang, that just means Excel is busy, just wait until the excution ends …​

 

[jackal764u]

Thank you
I am aware of the points you have highlighted.
My "it hangs (unresposive with grayed out screen)"statement still stands (in my mind at least).
- If the execution takes more than 10 minutes, in my time frame, it hangs.
- Excel is not busy, it has one workbook open (I use Win 7, i7 cpu, 8 GB Ram, SSD, So hardware isn't the issue).

The macro handles less data in seconds, but more than 10 minutes on more tells me the execution is not steamlined, uneconomical, loops somewhere, has a memory leak etc.
Call it what you like, but that is where your assistance is needed. Help me to resolve the macro's slow execution time in Excel

 

[offthelip]

Your problem is that your extra code has added an extra loop within a double loop making a three level loop , so assuming your arrays are 1000 rows your extra code will take 1000 times longer, than original code. So if it took 1 sec orginally it will now take 16 minutes . Seeing you inner loop is the same loop as the outer loop I would suggest you need to redesign your system to only do a double loop

 

[jackal764u]

Thank you
Your analysis makes total sense and highlights my suspisions with the macro.

My knowledge/ experience with vba is very limited. The unedited parts of the macro was provided by 'Fluff' which works as it should.
In my limited knowledge I added the extra code, which obviously is incorrect.

So again "Hat in hand", I request the help of better coders.

 

[offthelip]

I don't actually understand what your code is trying to do, but try this modification whihc I think does the same thing:

Sub AddCategories3() 'When changing cols just edit .range refs in "" commas
Application.ScreenUpdating = False
   Dim Ary As Variant, Nary As Variant, Nary2 As Variant    ' Nary=Cells K2 to N (MoneyData). Ary=Cells D2 to G (KW). Nary2=Cells D2 to I (MoneyData)
   Dim r As Long, i As Long, j As Long

   With Sheets("Keywords")
      Ary = .Range("D2", .Range("G" & Rows.Count).End(xlUp)).Value2     ' Value2 Uses real values that are not formatted i.e. date format
   End With
   With Sheets("MoneyData")
      If MsgBox("Reset IDs before running new search?", vbYesNo, "Reset") = vbYes Then .Range("K2:N" & .Rows.Count).ClearContents
      Nary = .Range("I2:N" & .Range("I" & Rows.Count).End(xlUp).Row)    'All Cells from K2 to N in MoneyData
      Nary2 = .Range("D2:I" & .Range("I" & Rows.Count).End(xlUp).Row)    'All Cells from D2 to I in MoneyData
   End With

   For r = 1 To UBound(Nary)    ' Nary = "I2:N" From Memo Col in (MoneyData)
        For i = 1 To UBound(Ary)  ' Ary =  "D2:G" From Payee Col in (KW)
            If Ary(i, 4) <> "" And InStr(1, Nary(r, 1), Ary(i, 4), vbTextCompare) Then     '  If Cells are not empty Then
               Nary(r, 3) = Ary(i, 1)  'Nary(r, Col K) = Ary(i, Col D) Correct payee from keywords sheet used
               Nary(r, 4) = Ary(i, 2)  'Nary(r, Col L) = Ary(i, Col E) Correct category from keywords sheet used
               Nary(r, 5) = Ary(i, 3)  'Nary(r, Col M) = Ary(i, Col F) Correct subcategory from keywords sheet used
               Nary(r, 6) = Ary(i, 4)  'Nary(r, Col N) = Ary(i, Col G) keyword used to categorize from keywords sheet
        Exit For   'my optional commenting out
             End If
''  End of my test code
        Next i
''  Start of My test code here
'        For j = r To UBound(Nary2) ' Nary2 = "D2:I" Memo Col D to Col I
             If Nary2(r, 6) = "" Then     ' does all @ once, I need line by line
'               Nary(r, 1) = "MData Memo is Empty"   'uncommented = keyword sheet, commented out = lines below, r, 1 stays empty
                Nary(r, 3) = Nary2(r, 1)  'Nary(r, Col K) = Nary2(j, Col D) Correct payee from Col D
                Nary(r, 4) = Nary2(r, 4)  'Nary(r, Col L) = Nary2(j, Col G) Correct category from Col G
                Nary(r, 5) = Nary2(r, 5)  'Nary(r, Col M) = Nary2(j, Col H) Correct subcategory from Col H
                Nary(r, 6) = Nary2(r, 6)  'Nary(r, Col N) = Nary2(j, Col I) keyword used to categorize from Col I
  '      Exit For
              End If  ' if commented out, runs through entire sheet, not just empty memo rows
 '       Next j
   
   Next r
   Sheets("MoneyData").Range("I2").Resize(UBound(Nary), 6).Value = Nary
   Sheets("MoneyData").Range("D2").Resize(UBound(Nary2), 6).Value = Nary2
Application.ScreenUpdating = True
End Sub

all I have done is moved your test code outside the inner loop ( it didn't use anything with the in index i , so it should be alright.
This should take only a few milliseconds longer that the original code

 

[jackal764u]

Thank You
You are Very Good at what you do.
Your amendments work like a charm.
Your macro now runs in under 90 seconds.

Please accept my sincere appreciation.

 

[offthelip]

I am pleased to hear it worked because it was a bit of a guess,

 

[anand3dinesh]

try truning off formulas if your worksheet contains formulas by addining one extra line in your code at the begining.
Application.Calculation = xlCalculationManual

turn back it to on at the end
Application.Calculation = xlCalculationAutomatic

i don't thinik it will make your code run super fast, but yeah it will help to run your code little faster.

 

[offthelip]

That won't make any difference because the code doesn't write to the worksheet except right at the end.