snippetModerate
Copy, Paste And Format
Viewed 0 times
andformatpastecopy
Problem
I am currently working with this code to automate some tasks for senior staff members that are not very adept in Excel. Wondering if VBA is simply not a very quick code or if my code is clunky and slow.
For clarity, I would think with how simple this code is it could run in under a second or two. Maybe this is overzealous?
```
Sub Paste()
'---Paste Macro
'---2016-05-23
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim LastRow As Long
Dim LastRow2 As Long
Dim LastColumn As Long
Dim StartCell1 As Range
Dim StartCell2 As Range
Dim rng1 As Range
Dim rng2 As Range
Set sht1 = GetWSFromCodeName("Sheet10")
Debug.Print sht1.Name
Set sht2 = GetWSFromCodeName("Sheet8")
Debug.Print sht2.Name
Set StartCell1 = Range("A2")
Set StartCell2 = Range("B2")
'Find Last Row and Column
LastRow = sht1.Cells(sht1.Rows.Count, StartCell1.Column).End(xlUp).Row
LastColumn = sht1.Cells(StartCell1.Row, sht1.Columns.Count).End(xlToLeft).Column
LastRow2 = sht2.Cells(sht2.Rows.Count, StartCell1.Column).End(xlUp).Row
'Select Range And Copy into Final Formula Sheet
sht1.Range(StartCell1, sht1.Cells(LastRow, LastColumn)).Copy Destination:=sht2.Cells(LastRow2 + 1, 2)
'Convert Text in Column C of Final Formula Sheet to Numbers to Allow Advisor Code to Apply
Set rng1 = Range(sht2.Cells(LastRow2, 3), sht2.Cells(LastRow2 + LastRow - 1, 3))
With rng1
.NumberFormat = "0"
.Value = .Value
End With
'Copy Advisor Function down to meet with new Pasted in Data
With sht2
Set rng2 = .Cells(LastRow2, 1)
End With
With rng2
.Copy Destination:=Range(sht2.Cells(LastRow2, 1), sht2.Cells(LastRow2 + LastRow - 1, 1))
End With
End Sub
'---This Function allows the worksheet name to change in the workbook as it allows the
'user to set Worksheets to codename variables. By using this function the user can input a
'codename for a worksheet and the function will call the worksheet name of the corresponding
'codename, allowing the user to set worksheet
For clarity, I would think with how simple this code is it could run in under a second or two. Maybe this is overzealous?
```
Sub Paste()
'---Paste Macro
'---2016-05-23
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim LastRow As Long
Dim LastRow2 As Long
Dim LastColumn As Long
Dim StartCell1 As Range
Dim StartCell2 As Range
Dim rng1 As Range
Dim rng2 As Range
Set sht1 = GetWSFromCodeName("Sheet10")
Debug.Print sht1.Name
Set sht2 = GetWSFromCodeName("Sheet8")
Debug.Print sht2.Name
Set StartCell1 = Range("A2")
Set StartCell2 = Range("B2")
'Find Last Row and Column
LastRow = sht1.Cells(sht1.Rows.Count, StartCell1.Column).End(xlUp).Row
LastColumn = sht1.Cells(StartCell1.Row, sht1.Columns.Count).End(xlToLeft).Column
LastRow2 = sht2.Cells(sht2.Rows.Count, StartCell1.Column).End(xlUp).Row
'Select Range And Copy into Final Formula Sheet
sht1.Range(StartCell1, sht1.Cells(LastRow, LastColumn)).Copy Destination:=sht2.Cells(LastRow2 + 1, 2)
'Convert Text in Column C of Final Formula Sheet to Numbers to Allow Advisor Code to Apply
Set rng1 = Range(sht2.Cells(LastRow2, 3), sht2.Cells(LastRow2 + LastRow - 1, 3))
With rng1
.NumberFormat = "0"
.Value = .Value
End With
'Copy Advisor Function down to meet with new Pasted in Data
With sht2
Set rng2 = .Cells(LastRow2, 1)
End With
With rng2
.Copy Destination:=Range(sht2.Cells(LastRow2, 1), sht2.Cells(LastRow2 + LastRow - 1, 1))
End With
End Sub
'---This Function allows the worksheet name to change in the workbook as it allows the
'user to set Worksheets to codename variables. By using this function the user can input a
'codename for a worksheet and the function will call the worksheet name of the corresponding
'codename, allowing the user to set worksheet
Solution
The 3 lowest-hanging VBA performance fruit are:
Just make sure to restore them at the end of your sub, and/or if your method encounters an error and stops, else your senior people won't be able to use Excel afterwards and will blame you for breaking it.
Used like so:
And with some (very basic) error handling:
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManualJust make sure to restore them at the end of your sub, and/or if your method encounters an error and stops, else your senior people won't be able to use Excel afterwards and will blame you for breaking it.
Used like so:
Sub/Function ()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic '/ Assuming it was set to automatic to begin with
End Sub/FunctionAnd with some (very basic) error handling:
Sub/Function ()
On Error Goto CleanFail
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic '/ Assuming it was set to automatic to begin with
CleanExit:
Exit Sub/Function
CleanFail:
'/ Resets the Application settings, *then* raises the error
On Error Goto 0
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic '/ Assuming it was set to automatic to begin with
Err.Raise(Err.Number) '/ Or insert your own error handling here
End Sub/FunctionCode Snippets
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManualSub/Function ()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
< Code >
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic '/ Assuming it was set to automatic to begin with
End Sub/FunctionSub/Function ()
On Error Goto CleanFail
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
< Code >
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic '/ Assuming it was set to automatic to begin with
CleanExit:
Exit Sub/Function
CleanFail:
'/ Resets the Application settings, *then* raises the error
On Error Goto 0
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic '/ Assuming it was set to automatic to begin with
Err.Raise(Err.Number) '/ Or insert your own error handling here
End Sub/FunctionContext
StackExchange Code Review Q#129187, answer score: 12
Revisions (0)
No revisions yet.