Speeding up macro

gd6noob

Board Regular
Joined
Oct 20, 2017
Messages
108
Office Version
  1. 2016
Platform
  1. Windows
Hi guys,

Just wanted to see if there was anyway to speed this code up... I read that you can assigned cell values instead of copy/paste method but cant figure it out.

Basically,
Column A on destination is copying IDs from source.
Columns D, F, H are copying times using vlookup.
Columns C, E, G are saying if there is a time, then this.

the "speedup.scr" is the usual turning off screenupdates, setting calculations to manual then auto, etc. I just have that code exported to save me time so I dont always have to re-write it.. just import and call it..


Thank you for any help.

VBA Code:
Sub copy()
 
  speedup.scr False
 
    Dim Source As Worksheet, Destination As Worksheet

    Set Source = ThisWorkbook.Worksheets("CAN Daily Hours Summary")
    Set Destination = ThisWorkbook.Worksheets("Adjustment_Data")

    Destination.Range("A1").CurrentRegion.Offset(1).Cells.clear
    Source.Activate
    Range("A:A").Select
        With Selection
            .NumberFormat = "General"
            .Value = .Value
        End With
    Range("A2", Range("A2").End(xlDown)).copy Destination.Range("A2")

    Destination.Activate
   
    LastRow1 = ActiveSheet.Cells(Rows.Count, 1).End(3).row
   
    Range("B2").Formula = "=IF(IFERROR(LEFT('CAN Daily Hours Summary'!B2, SEARCH("","", 'CAN Daily Hours Summary'!B2)-1),"""")=0,"""",IFERROR(LEFT('CAN Daily Hours Summary'!B2, SEARCH("","", 'CAN Daily Hours Summary'!B2)-1),""""))"
    Range("B2").Select
    If Not LastRow1 <= 2 Then Selection.AutoFill Destination:=Range("B2:B" & LastRow1)
       
    Range("C2").Formula = "=IF(D2<>"""",""Role Premium"","""")"
    Range("C2").Select
    If Not LastRow1 <= 2 Then Selection.AutoFill Destination:=Range("C2:C" & LastRow1)
       
    Range("D2").Formula = "=INDEX('CAN Daily Hours Summary'!$K:$K,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
    Range("D2").Select
    If Not LastRow1 <= 2 Then Selection.AutoFill Destination:=Range("D2:D" & LastRow1)
   
    Range("E2").Formula = "=IF(F2<>"""",""RolePrmium2OT"","""")"
    Range("E2").Select
    If Not LastRow1 <= 2 Then Selection.AutoFill Destination:=Range("E2:E" & LastRow1)
   
    Range("F2").Formula = "=INDEX('CAN Daily Hours Summary'!$L:$L,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
    Range("F2").Select
    If Not LastRow1 <= 2 Then Selection.AutoFill Destination:=Range("F2:F" & LastRow1)
   
    Range("G2").Formula = "=IF(H2<>"""",""RolePrmium2DT"","""")"
    Range("G2").Select
    If Not LastRow1 <= 2 Then Selection.AutoFill Destination:=Range("G2:G" & LastRow1)
   
    Range("H2").Formula = "=INDEX('CAN Daily Hours Summary'!$M:$M,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
    Range("H2").Select
    If Not LastRow1 <= 2 Then Selection.AutoFill Destination:=Range("H2:H" & LastRow1)
   

  speedup.scr True

End Sub
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,053
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Not sure if it's any quicker, but shorter
VBA Code:
Sub copy()
  speedup.scr False
    Dim Source As Worksheet, Destination As Worksheet
    Set Source = Worksheets("CAN Daily Hours Summary")
    Set Destination = Worksheets("Adjustment_Data")
    Destination.Range("A1").CurrentRegion.Offset(1).Cells.Clear
    Source.Activate
        With Range("A:A")
            .NumberFormat = "General"
            .Value = .Value
        End With
    Range("A2", Range("A2").End(xlDown)).copy Destination.Range("A2")
    Destination.Activate
    LastRow1 = ActiveSheet.Cells(Rows.Count, 1).End(3).Row
    Range("B2:B" & LastRow1).Formula = "=IF(IFERROR(LEFT('CAN Daily Hours Summary'!B2, SEARCH("","", 'CAN Daily Hours Summary'!B2)-1),"""")=0,"""",IFERROR(LEFT('CAN Daily Hours Summary'!B2, SEARCH("","", 'CAN Daily Hours Summary'!B2)-1),""""))"
    Range("C2:C" & LastRow1).Formula = "=IF(D2<>"""",""Role Premium"","""")"
    Range("D2:D" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$K:$K,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
    Range("E2:E" & LastRow1).Formula = "=IF(F2<>"""",""RolePrmium2OT"","""")"
    Range("F2:F" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$L:$L,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
    Range("G2:G" & LastRow1).Formula = "=IF(H2<>"""",""RolePrmium2DT"","""")"
    Range("H2:H" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$M:$M,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
  speedup.scr True
End Sub
 
Solution

gd6noob

Board Regular
Joined
Oct 20, 2017
Messages
108
Office Version
  1. 2016
Platform
  1. Windows
Not sure if it's any quicker, but shorter
VBA Code:
Sub copy()
  speedup.scr False
    Dim Source As Worksheet, Destination As Worksheet
    Set Source = Worksheets("CAN Daily Hours Summary")
    Set Destination = Worksheets("Adjustment_Data")
    Destination.Range("A1").CurrentRegion.Offset(1).Cells.Clear
    Source.Activate
        With Range("A:A")
            .NumberFormat = "General"
            .Value = .Value
        End With
    Range("A2", Range("A2").End(xlDown)).copy Destination.Range("A2")
    Destination.Activate
    LastRow1 = ActiveSheet.Cells(Rows.Count, 1).End(3).Row
    Range("B2:B" & LastRow1).Formula = "=IF(IFERROR(LEFT('CAN Daily Hours Summary'!B2, SEARCH("","", 'CAN Daily Hours Summary'!B2)-1),"""")=0,"""",IFERROR(LEFT('CAN Daily Hours Summary'!B2, SEARCH("","", 'CAN Daily Hours Summary'!B2)-1),""""))"
    Range("C2:C" & LastRow1).Formula = "=IF(D2<>"""",""Role Premium"","""")"
    Range("D2:D" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$K:$K,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
    Range("E2:E" & LastRow1).Formula = "=IF(F2<>"""",""RolePrmium2OT"","""")"
    Range("F2:F" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$L:$L,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
    Range("G2:G" & LastRow1).Formula = "=IF(H2<>"""",""RolePrmium2DT"","""")"
    Range("H2:H" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$M:$M,MATCH(A2,'CAN Daily Hours Summary'!$A:$A))"
  speedup.scr True
End Sub
Thank you for that shorter code..

I think I got it.. I used the Array for a few things.
Instead of selecting the range and converting to "General" I just pasted that for my formula, due to it being stored as text.
Then I also pasted that in my Source. its working with no errors but not sure if theres a better way to do this.

VBA Code:
Sub test()
    speedup.scr False
    
    Dim Source As Worksheet, Destination As Worksheet
    Set Source = ThisWorkbook.Worksheets("CAN Daily Hours Summary")
    Set Destination = ThisWorkbook.Worksheets("Adjustment_Data")
        
    Dim arr As Variant
    arr = Source.Range("A1").CurrentRegion.Offset(1)
    
    Dim i As Long
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        arr(i, 1) = arr(i, 1)
    Next i
    
    Destination.Range("A1").CurrentRegion.Offset(1).ClearContents
    
    Dim rowcount As Long, colummcount As Long
    rowcount = UBound(arr, 1)
    
    Source.Range("A2").Resize(rowcount).Value = arr
    Destination.Range("A2").Resize(rowcount).Value = arr

    LastRow1 = ActiveSheet.Cells(Rows.Count, 1).End(3).row
    Range("B2:B" & LastRow1).Formula = "=IF(IFERROR(LEFT('CAN Daily Hours Summary'!B2, SEARCH("","", 'CAN Daily Hours Summary'!B2)-1),"""")=0,"""",IFERROR(LEFT('CAN Daily Hours Summary'!B2, SEARCH("","", 'CAN Daily Hours Summary'!B2)-1),""""))"
    Range("C2:C" & LastRow1).Formula = "=IF(D2<>"""",""Role Premium"","""")"
    Range("D2:D" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$K:$K,MATCH(Adjustment_Data!$A2,'CAN Daily Hours Summary'!$A:$A,0))"
    Range("E2:E" & LastRow1).Formula = "=IF(F2<>"""",""RolePrmium2OT"","""")"
    Range("F2:F" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$L:$L,MATCH(Adjustment_Data!$A2,'CAN Daily Hours Summary'!$A:$A,0))"
    Range("G2:G" & LastRow1).Formula = "=IF(H2<>"""",""RolePrmium2DT"","""")"
    Range("H2:H" & LastRow1).Formula = "=INDEX('CAN Daily Hours Summary'!$M:$M,MATCH(Adjustment_Data!$A2,'CAN Daily Hours Summary'!$A:$A,0))"


    speedup.scr True
End Sub
 

gd6noob

Board Regular
Joined
Oct 20, 2017
Messages
108
Office Version
  1. 2016
Platform
  1. Windows
Can I use the Array method to copy different columns?
Like column A from Source to Destination and then columns D to G from Source to Destination? Im not having success using another arr
 

Watch MrExcel Video

Forum statistics

Threads
1,128,022
Messages
5,628,186
Members
416,299
Latest member
arunvistas

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