Looking to learn: My code works, but can you speed it up?

[00jaggy]

Hello - my code below works fine and runs in under 8 seconds. However, I wanted to see if anyone wants to take the time to teach me better coding techniques with the hopes of speeding this up or eliminating Excel calculations.

Background:
I have a master list ("Datasource" tab) with employee names and their vacation entitlement. I have a template sheet created.
This code copies the template sheet and creates a new worksheet for each employee listed on the Datasource tab.
I couldn't figure out how to Index/Match certain data in VBA, so instead, I use an Index/Match Excel formula on the Template worksheet which looks up the Employees name. Then I copy and paste special data these looked up values so I can email the sheets to employees and not have to include the Datasource tab.

On the Datasource tab:
Column C - Employee name
Column B - Employee number
Column G - Start date
Column L - Vacation entitlement in days

Option Explicit


Sub CreateTemplates()


'*****************************************************************************************************************


'Macro which will create a copy of the "Template" worksheet for each name listed in column C of the DataSource tab


'*****************************************************************************************************************


Dim rcell As Range
Dim DS As Worksheet
Dim LastRow As Long




'Speed boost - turns of screen refreshing
Application.ScreenUpdating = False


'If the "Template" worksheet is hidden, this will unhide it


Sheets("Template").Visible = xlSheetVisible
    
'Makes the DataSource tab the active worksheet


Set DS = ActiveWorkbook.Sheets("DataSource")
Worksheets("Datasource").Activate


    
'Defines the range of data in column C of the DataSource tab


LastRow = DS.Range("C" & DS.Rows.Count).End(xlUp).Row
    
'Creates a copy of the "Template" tab and renames it for every name listed in Column C of the DataSource tab


    For Each rcell In Range("C2:C" & LastRow)
        
        If rcell.Value <> "" Then
            Sheets("Template").Copy After:=Sheets("Template")
            Sheets("Template (2)").Name = rcell.Value
        End If
            
    Next rcell
    
'Run the SortSheets Macro to sort the worksheets alphabetically.  Refer to Sub below.
Call SortSheets


'Run the macro that hard codes certain formula.  Refer to Sub below.
ConvertToValues


'Set the Datasource tab as the active worksheet after macro runs.
Worksheets("Datasource").Activate


'Turn screen refresh back on
Application.ScreenUpdating = True


End Sub


Sub SortSheets()


'***********************************************


'Sorts the sheets alphabetically
'Copied this code from the web.  No notes added.


'***********************************************


Dim n As Integer, M As Integer, FirstWSToSort As Integer, LastWSToSort As Integer
Dim SortDescending As Boolean




    If ActiveWindow.SelectedSheets.Count = 1 Then
        FirstWSToSort = ActiveSheet.Index
        LastWSToSort = Worksheets.Count
    Else
        With ActiveWindow.SelectedSheets
            For n = 2 To .Count
                If .Item(n - 1).Index <> .Item(n).Index - 1 Then
                    MsgBox "You cannot sort non-adjacent sheets"
                    Exit Sub
                End If
            Next n
            FirstWSToSort = .Item(1).Index
            LastWSToSort = .Item(.Count).Index
         End With
    End If
    
    For M = FirstWSToSort To LastWSToSort
    For n = M To LastWSToSort
        If SortDescending = True Then
            If UCase(Worksheets(n).Name) > UCase(Worksheets(M).Name) Then
                Worksheets(n).Move Before:=Worksheets(M)
            End If
        Else
            If UCase(Worksheets(n).Name) < UCase(Worksheets(M).Name) Then
               Worksheets(n).Move Before:=Worksheets(M)
            End If
        End If
     Next n
Next M


End Sub


Sub ConvertToValues()


'*****************************************************************************************************************


'This code will take the cells using index/match on the template sheet and paste special values so that the sheets
    'can be emailed out to employees without the need to include the Datasource tab


'*****************************************************************************************************************


Dim WS As Worksheet


   For Each WS In Worksheets
        'We will exclude the following two worksheets from this loop
        If IsError(Application.Match(WS.Name, Array("Datasource", "Template"), 0)) Then
         
           'The are the three cells that have formulas on the worksheet looking up to the
                'Datasource tab.  Copy and paste special values these formula.
            
           WS.Range("K5").Copy
           WS.Range("K5").PasteSpecial Paste:=xlPasteValues
           WS.Range("D6").Copy
           WS.Range("D6").PasteSpecial Paste:=xlPasteValues
           WS.Range("D8").Copy
           WS.Range("D8").PasteSpecial Paste:=xlPasteValues
        
        End If
   Next WS
   
'Turn off native Excel pop up alert
Application.DisplayAlerts = False


    'Delete the "Test Employee" worksheet pulling from Datasource line 2
    Set WS = Worksheets("Test Employee")
    WS.Delete


'Turn the pop ups back on
Application.DisplayAlerts = True
  
'Clear the clipboard and marching ants
Application.CutCopyMode = False


End Sub

Thanks!

 

[tlowry]

Well, not so much. I think you may be asking a good question, but not the most important one. If it works correctly in 8 seconds, how much time can you save? How about asking how easy is this code to maintain? If it takes 30 minutes to find, change and test a code change how many 8 seconds would that be? Remember, the person making the changes, hopefully, will not be you.

Here is a snippet of code that I think may give you some ideas for code design. Ask: what would need to be done to modify what cells need to be converted?

Sub main009()
 
    ConvertToValues (Array("K5", "D6", "D8"))
   
End Sub
 
Sub ConvertToValues(ArrOfConvert)
    Dim cCell
    Dim WS As Worksheet
    For Each WS In Worksheets
        Select Case WS.Name
            Case "Datasource", "Template"
            Case Else
                For Each cCell In ArrOfConvert
                    Range(cCell).Value = _
                        Application.Evaluate(Range(cCell).Formula)
                Next
        End Select
    Next WS
End Sub

 

[00jaggy]

Thanks for the tips and code tlowry. I'll play around with what you sent and see if I can understand and implement it.

Cheers.