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

#### 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

Rcntr1 = .Range("E2", .Range("E" & .Rows.Count).End(xlUp)).Rows.Count
End With

Rcntr2 = .Range("E2", .Range("E" & .Rows.Count).End(xlUp)).Rows.Count
End With

Rcntr3 = .Range("E2", .Range("E" & .Rows.Count).End(xlUp)).Rows.Count
End With

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
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
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
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``````
------

#### Marc L

##### Excel Ninja
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 …​

#### p45cal

##### Well-Known Member
Try:
Code:
``````Sub RowCounterChanged()
Dim RcntrM As Long, Wcntr As Long, i As Long, DestnSht As Worksheet, ExistingMs As Range, sht As Worksheet

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

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:

#### Puneetk

##### New Member
Try:
Code:
``````Sub RowCounterChanged()
Dim RcntrM As Long, Wcntr As Long, i As Long, DestnSht As Worksheet, ExistingMs As Range, sht As Worksheet

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

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.
- 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
- point taken, will attach the workbook in my queries from now on.

I

#### Puneetk

##### New Member
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 …​
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 ?

#### Marc L

##### Excel Ninja
Some codeline like `Worksheets(…).[A:G].Rows(i).Copy …`
But follow post #3 code too …​

#### Hui

##### Excel Ninja
Staff member
Worksheet.Range("A" & ctsr(i) & ":G" & cstr(i)).copy