Speeding up macro

G

gd6noob

Board Regular
Joined
Oct 20, 2017
Messages
170
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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Sort by date Sort by votes
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
 
Upvote 0
Solution
Michael M said:
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
Click to expand...
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Rename a Sheet
Replies
2
Views
108
Peter_SSs
Peter_SSs
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
208
Coco1
C
L
  • Question
Variable Rows, Help Speeding Up
Replies
4
Views
318
kevin9999
K
PIsabel
  • Solved
Speed up
Replies
4
Views
93
Alex Blakenburg
A
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
964
Joe4
Joe4

Forum statistics

Threads
1,214,943
Messages
6,122,380
Members
449,080
Latest member
Armadillos

Share this page

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
Back
Top