11
\$\begingroup\$

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 variables to codenames without losing
 'functionality usually associated with such variables.
'---2016年05月23日
Public Function GetWSFromCodeName(CodeName As String) As Worksheet
 Dim WS As Worksheet
 For Each WS In ThisWorkbook.Worksheets
 If StrComp(WS.CodeName, CodeName, vbTextCompare) = 0 Then
 Set GetWSFromCodeName = WS
 Exit Function
 End If
 Next WS
End Function
200_success
145k22 gold badges190 silver badges478 bronze badges
asked May 24, 2016 at 13:39
\$\endgroup\$
6
  • 4
    \$\begingroup\$ How quick is it? How quick do you want it to be? Also, what is GetWSFromCodeName? \$\endgroup\$ Commented May 24, 2016 at 13:51
  • 3
    \$\begingroup\$ Thanks @Zak! currently looking over your answer and seeing how it implements into my design. I feel it is promising, and will open me up to a new world of fool proof, though the world will always build a better fool. I'l update once I get everything in working order! \$\endgroup\$ Commented May 24, 2016 at 14:11
  • 1
    \$\begingroup\$ Also, things that often catch new people out: If you want to take the answers and incorporate them into your code and then get feedback on the *new* code, you need to do it in a follow-up question, detailed here \$\endgroup\$ Commented May 24, 2016 at 14:11
  • 1
    \$\begingroup\$ For your next question I'd recommend you wait a while before accepting answers. @Zak's answer is excellent, but you may attract more answers by leaving it open. \$\endgroup\$ Commented May 24, 2016 at 15:38
  • 1
    \$\begingroup\$ It's just been pointed out to me that the previous link was broken. Apologies for that. If you want to drop by chat, this is the correct link \$\endgroup\$ Commented May 24, 2016 at 15:42

1 Answer 1

12
\$\begingroup\$

The 3 lowest-hanging VBA performance fruit are:

 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlManual

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:

Sub/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/Function

And with some (very basic) error handling:

Sub/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/Function
answered May 24, 2016 at 13:58
\$\endgroup\$
2
  • 6
    \$\begingroup\$ Wow! Amazing how such a simple thing like stopping excel from making itself its own worst nightmare of constantly updating makes this code run infinitely faster! Fantastically simple answer to what I presume is also a fairly simple question. Many thanks to you and everyone else that stopped by! \$\endgroup\$ Commented May 24, 2016 at 14:51
  • 4
    \$\begingroup\$ I recommend you put your new code up for review. There's a lot of other things that you should get into the habit of doing. \$\endgroup\$ Commented May 24, 2016 at 15:27

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.