• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

My Macros makes my laptop so slow : Optimization of my Macro code

P

Puneetk

New Member
Hi Everyone,
Looking for some help.

I have written a macro which basically collates data from 3 different files, pastes into different sheets of my master file (Admin Console) and then create a single dashboard with all data into single file (Dashboard).

I also wanted to ensure that I don't overwrite old data in Dashboard sheet, and hence written a subcode to do the INSERT only if the rows is not pre existing.

Now my challenge is that the code is too slow while I am using hardly 2500 rows of total data. Can you guys help me optimize this code so that it works cleaner and faster.

-------------------------------------------------

>>> use code - tags <<<
Code: 
Sub RowCounter()

Dim Rcntr1 As Integer
Dim Rcntr2 As Integer
Dim Rcntr3 As Integer
Dim RcntrM As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim Dup As Integer
Dim Duplicate As Integer

With Workbooks("Admin Console-WIP.xlsm").Sheets("Simran")
    Rcntr1 = .Range("E2", .Range("E" & .Rows.Count).End(xlUp)).Rows.Count
End With

With Workbooks("Admin Console-WIP.xlsm").Sheets("Sravanthi")
    Rcntr2 = .Range("E2", .Range("E" & .Rows.Count).End(xlUp)).Rows.Count
End With

With Workbooks("Admin Console-WIP.xlsm").Sheets("Deepanshi")
    Rcntr3 = .Range("E2", .Range("E" & .Rows.Count).End(xlUp)).Rows.Count
End With


With Workbooks("Admin Console-WIP.xlsm").Sheets("Dashboard")
    RcntrM = .Range("E2", .Range("E" & .Rows.Count).End(xlUp)).Rows.Count
End With

MsgBox ("no. of Rows are" & Rcntr1 & "," & Rcntr2 & "," & Rcntr3 & "," & RcntrM)

Wcntr = RcntrM + 1
Duplicate = 0

'Copying data from Sravanthi Sheet
For i = 2 To Rcntr2
    Dup = 0
    With Workbooks("Admin Console-WIP.xlsm").Sheets("Sravanthi")
       For j = 2 To RcntrM
            If (Worksheets("Sravanthi").Range("G" & i).Value = Worksheets("Dashboard").Range("M" & j).Value) Then
                Dup = Dup + 1
            End If
        Next j
        If Dup = 0 Then
            For k = 0 To 19
                  Worksheets("Sravanthi").Range("A" & i).Offset(0, k).Copy Worksheets("Dashboard").Range("G" & Wcntr).Offset(0, k)
            Next k
        Wcntr = Wcntr + 1
        End If
    End With
Next i

   'Copying data from Simran Sheet
For i = 2 To Rcntr1
Dup = 0
l = 0
    With Workbooks("Admin Console-WIP.xlsm").Sheets("Simran")
       For j = 2 To RcntrM
            If (Worksheets("Simran").Range("G" & i).Value = Worksheets("Dashboard").Range("M" & j).Value) Then
                Dup = Dup + 1
            End If
        Next j
       
        If Dup = 0 Then
            For k = 0 To 20
                  Worksheets("Simran").Range("A" & i).Offset(0, k).Copy Worksheets("Dashboard").Range("G" & Wcntr).Offset(0, k)
            Next k
        Wcntr = Wcntr + 1
        End If
    End With
Next i


'Copying data from Deepanshi Sheet
For i = 2 To Rcntr3
Dup = 0
l = 0
    With Workbooks("Admin Console-WIP.xlsm").Sheets("Deepanshi")
       For j = 2 To RcntrM
            If (Worksheets("Deepanshi").Range("G" & i).Value = Worksheets("Dashboard").Range("M" & j).Value) Then
                Dup = Dup + 1
            End If
        Next j
       
        If Dup = 0 Then
            For k = 0 To 20
                  Worksheets("Deepanshi").Range("A" & i).Offset(0, k).Copy Worksheets("Dashboard").Range("G" & Wcntr).Offset(0, k)
            Next k
        Wcntr = Wcntr + 1
        End If
    End With
Next i

MsgBox ("Operations Complete")
End Sub
------
 
Hi !​
​
First, you must use code tags when posting a code via the 3 dots icon !​
  • Lack of logic in some loops …
    When finding a duplicate no need to continue the loop to count how many duplicates !
    So Dup = 1: Exit For rather than Dup = Dup + 1 …

  • Some loops are useless …
    It's faster to copy a range of cells rather than cell by cell !

  • You can - must ! - desactivate the display during the execution, see ScreenUpdating in VBA help …
It's what often happens when using a classic loop algorithm instead of Excel basics …​
​
 
Try:
Code: 
Sub RowCounterChanged()
Dim RcntrM As Long, Wcntr As Long, i As Long, DestnSht As Worksheet, ExistingMs As Range, sht As Worksheet

With Workbooks("Admin Console-WIP.xlsm")
  Set DestnSht = .Worksheets("Dashboard")
  With DestnSht
    RcntrM = .Range("E" & .Rows.Count).End(xlUp).Row
    Set ExistingMs = .Range("M2:M" & RcntrM)
    Wcntr = RcntrM + 1
  End With
  
  For Each sht In .Sheets(Array("Sravanthi", "Simran", "Deepanshi"))
    With sht
      For i = 2 To .Range("E" & .Rows.Count).End(xlUp).Row - 1
        If IsError(Application.Match(.Range("G" & i).Value, ExistingMs, 0)) Then
          .Range("A" & i).Resize(, 20).Copy DestnSht.Range("G" & Wcntr)
          Wcntr = Wcntr + 1
        End If
      Next i
    End With 'sht
  Next sht
End With 'Workbooks("Admin Console-WIP.xlsm")

MsgBox ("Operations Complete")
End Sub
However I have some concerns:
  • I think you might have been overwriting the last row of pre-existing data on the Dashboard sheet. The above code might do the same, if so change Wcntr = RcntrM + 1 to Wcntr = RcntrM + 2 in your code (I don't think my code will need it - but double-check).
  • In your code for one of the sheets you have For k = 0 To 19 and in the others For k = 0 To 20. Is this just a typo or is it deliberate? My code assumes 20 (it's the 21 in .Range("A" & i).Resize(, 21).Copy (0 to 20 is 21 cells)). I can adjust for this if necessary.
When this is working properly we can add Application.ScreenUpdating=False/True lines to speed it up a bit more.

I have updated the code without being able to test it, which means it's very likey to have faults, it's best to attach a workbook so that we can easily test and not make incorrect assumptions about your workbook/data.
 
Last edited:
p45cal said:
Try:
Code: 
Sub RowCounterChanged()
Dim RcntrM As Long, Wcntr As Long, i As Long, DestnSht As Worksheet, ExistingMs As Range, sht As Worksheet

With Workbooks("Admin Console-WIP.xlsm")
  Set DestnSht = .Worksheets("Dashboard")
  With DestnSht
    RcntrM = .Range("E" & .Rows.Count).End(xlUp).Row
    Set ExistingMs = .Range("M2:M" & RcntrM)
    Wcntr = RcntrM + 1
  End With
 
  For Each sht In .Sheets(Array("Sravanthi", "Simran", "Deepanshi"))
    With sht
      For i = 2 To .Range("E" & .Rows.Count).End(xlUp).Row - 1
        If IsError(Application.Match(.Range("G" & i).Value, ExistingMs, 0)) Then
          .Range("A" & i).Resize(, 20).Copy DestnSht.Range("G" & Wcntr)
          Wcntr = Wcntr + 1
        End If
      Next i
    End With 'sht
  Next sht
End With 'Workbooks("Admin Console-WIP.xlsm")

MsgBox ("Operations Complete")
End Sub
However I have some concerns:
  • I think you might have been overwriting the last row of pre-existing data on the Dashboard sheet. The above code might do the same, if so change Wcntr = RcntrM + 1 to Wcntr = RcntrM + 2 in your code (I don't think my code will need it - but double-check).
  • In your code for one of the sheets you have For k = 0 To 19 and in the others For k = 0 To 20. Is this just a typo or is it deliberate? My code assumes 20 (it's the 21 in .Range("A" & i).Resize(, 21).Copy (0 to 20 is 21 cells)). I can adjust for this if necessary.
When this is working properly we can add Application.ScreenUpdating=False/True lines to speed it up a bit more.

I have updated the code without being able to test it, which means it's very likey to have faults, it's best to attach a workbook so that we can easily test and not make incorrect assumptions about your workbook/data.
Click to expand...

- Super-awesome and crisp code.. haven't run it yet.. will run it and share the findings. Thanks a lot already mate !
- About the point of overwriting.. let me check carefully again.. maybe I didn't realize it
- Yeah, that was a typo.. I should make it 19 across all sheets, thanks for pointing it out
- Yes I was thinking of adding screenupdating=false, will add it
- point taken, will attach the workbook in my queries from now on.

I
 
Marc L said:
Hi !​
​
First, you must use code tags when posting a code via the 3 dots icon !​

  • Lack of logic in some loops …
    When finding a duplicate no need to continue the loop to count how many duplicates !
    So Dup = 1: Exit For rather than Dup = Dup + 1 …

  • Some loops are useless …
    It's faster to copy a range of cells rather than cell by cell !

  • You can - must ! - desactivate the display during the execution, see ScreenUpdating in VBA help …
It's what often happens when using a classic loop algorithm instead of Excel basics …​
​
Click to expand...
Thanks ! great point on Dup variable.. will correct it now. that will surely make it faster
yes, now I am deactivating screen update.
Regarding copying complete range/ row, I totally agree with you but I was not able to understand as to how to use range copy function when range reference cells are both variable, like in this case, the columns to be copies are fixed but the row numbers are changing. So should I write---

Worksheet.Range. copy(A &i: G&i) worksheet.range(A&i: G&i) /// this wasn't working since I guess I can't use "&" operator twice in the same range.

do you have any suggestions on this ?
 
You must log in or register to reply here.
Back
Top