Help Streamlining Code

[DuncanC66]

Good Day,
I would like to see if there is someone out there who could help me with making my code more streamlined. I am self-taught and have been doing a lot of projects. I try each time I do a new project to learn something new and apply it to the code I am working on. A BIG Thank you for all your help over the years by the way!
When I first started coding I tried to follow the logic as if I were creating a new sheet from scratch, or actually working on a sheet as an end user. For example I would have my code open to the sheet and activate it, then I would activate a cell then copy it then move to the next sheet, activate the cell and paste. This made sense to me as that is how I would perform the task if I were actually in the sheet performing the work manually.

Now I am at the point where I can use variables and loops and most importantly can do a statement along the lines of Ws1.Range(“A1:D6”).Value = Ws2.Range(“A1:D6”).Value.
However I still have trouble separating myself from doing my logic based on as if I were in the sheet doing the work myself.

So I was hoping to try and have any guru out there that could look over my code and give me some tips for cleaning it up. Perhaps better logic. Perhaps better ways of naming or calling sheets or workbooks.

Here is some code I have created recently. It seems to work most of the time but every once and a while I get bugs. This is a scheduling and attendance tracking sheet for a large company with room for 350 employees. The turnover is fierce so each week the new schedule is created then the results are applied to a template and copied and pasted into the workbook for the new week. The process is then repeated up to 13 times a quarter.

Option Explicit

Sub CreateWeekSheet(Optional control As IRibbonControl)
' ------------------------------------------------'
' This Macro deletes existing Data within the Template.'
' Then it Adds the Current Schedule to it, overwriting the existing data.'
' Then it checks to make sure the week doesn't exist all ready, and Copies the Template.'
' It renames it and Locates it at the end of the Workbook.'
' Then Reformats the Conditional Formatting, and Protects the sheet.'
' ------------------------------------------------'
'
Dim ShtCount As Integer ' Sheet Count, How many sheets in workbook currently'
Dim WkName As Integer   ' Week Name, Name of last sheet in workbook ex 7-25'
Dim mReply As Integer   ' Message Box Reply, used for prompts'
Dim ShtName As String   ' Sheet Name, Current sheet name, Variable'
Dim MyName As Name      ' My Formula Names, Reference to predefined names in sheet'
Dim shDate As Date
Dim shMonth As Integer, shDay As Integer
Dim AutoBuild As String
 
Application.ScreenUpdating = False
   
' Define ShtCount and WkName'
ShtCount = Sheets.Count
WkName = ShtCount - 2 'Can be up to 15 sheets, 1 of which is template another is Employee Data'
 
'===================================================
' Comment this line out if sending to Client'
' Used to remove messages during sheet build'
'    AutoBuild = "yes"
'===================================================
 
If WkName > 1 Then 'Get name of last sheet if after wk1 for date formula
    Sheets(Sheets.Count).Select
    ShtName = ActiveSheet.Name
End If
 
If AutoBuild = "yes" Then GoTo SkpMsg1
 
        mReply = MsgBox(Prompt:="You are about to add Week " & WkName & ". Is this correct?", _
            Buttons:=vbOK, Title:="Add Next Week")
 
        If mReply = vbOK Then ' Everything is good run the Macro.
 
SkpMsg1:
 
            Sheets("TemplateSheet").Visible = True ' Unhide Template Sheet'
 
            Call ClearAttendanceDataFrom7Days 'Code Below'
            Call PopulateTemplateMacro 'Code Below'
 
            Sheets("TemplateSheet").Copy After:=Sheets(Sheets.Count) ' Create New Sheet, Put at end'
 
            Range("B2").Select ' Select Name of Sheet Title'
            ActiveCell.FormulaR1C1 = "Week " & WkName & " A-Schedule" ' Change Name of Sheet Title'
            Range("E5").Select ' Select Start Date'
 
                On Error Resume Next
                For Each MyName In Worksheets("Wk" & WkName).Names
                    MyName.Delete
                Next MyName
 
                If WkName = 1 Then ' If this is First Sheet, Leave Original Formula'
 
                    Range("A1").Select
                Else ' If not first then, Add Date 7 days greater than last sheet'
                    ActiveCell.FormulaR1C1 = "='" & ShtName & "'!RC+7"
                    Range("A1").Select
                End If
            Sheets("TemplateSheet").Visible = False 'Hide Template Sheet'
 
            Sheets("Wk" & WkName).Select ' Reselect Latest Sheet'
 
            ' Define Date, Day and Month for Sheet Name'
            shDate = ActiveSheet.Range("E5").Value
            shMonth = Format(shDate, "mm")
            shDay = Format(shDate, "dd")
           
            ' Create New Sheet Name'
            Sheets("TemplateSheet (2)").Name = shMonth & "-" & shDay ' Rename Sheet to New week Name'
           
            ' Create Custom Formats for New Sheet'
            Call CreateConditionalFormatMacro 'Runs Conditional Formatting macro'
       
        ElseIf mReply = vbCancel Then ' They need to choose a different Button'
   
            Exit Sub
           
        End If
   
If AutoBuild = "yes" Then GoTo SkpMsg2
    If MsgBox("Done", vbOKOnly) = vbOK Then
    End If
SkpMsg2:
  
End Sub

Sub ClearAttendanceDataFrom7Days()
Application.ScreenUpdating = True
' ------------------------------------------------'
' This Utility is used to delete all attendance data
' from the entire Template Sheet.
' Used to clean it up before submitting.
' ------------------------------------------------'
'
Dim wb As Workbook
Dim ws As Worksheet
Dim wkrng As Range
Dim ShiftCt As Integer, DayCt As Integer, RowOV As Integer, ColOV As Integer


Application.ScreenUpdating = False
          
    ' Set up the variables for Workbook, Worksheet and Working Range
    ' ------------------------------------------------'
    Set wb = ActiveWorkbook                 ' Set wb to equal this workbook
    Set ws = Sheets("TemplateSheet")        ' Set ws to equal this worksheet
    Set wkrng = ws.Range("N10:Y69")         ' Set wkrng to equal the Attendance Data Range to work within


    
    wb.Activate                             ' Activate the current Workbook
    ws.Visible = True                       ' Make sure it is unhidden
    ws.Select                               ' Activate the Template Sheet
    
    ' Delete existing data in Monday Morning Shift Overides, Notes and Attendance'
    ' ------------------------------------------------'
    wkrng.ClearContents                     ' Delete any values in Day1 Morning Shift to be used as the template for the rest of sheet
        
    ' Loop through Attendance Data Weekdays and Shifts
    ' ------------------------------------------------'
    For DayCt = 0 To 6                      ' 7 Days, starts with 0 so the first runthrough offset will equal 0
        
        ColOV = DayCt * 35                  ' 35 is the offset from one day to the next


        For ShiftCt = 0 To 4                ' 5 Shifts, starts with 0 so the first runthrough offset will equal 0


            RowOV = ShiftCt * 72            ' 72 is the offset from one shift to the next
            
            wkrng.Offset(RowOV, ColOV).Select                   ' Select command for debugging purposes only
            wkrng.Offset(RowOV, ColOV).Value = wkrng.Value      ' Transfers blank cells to current offset values
            
        Next ShiftCt                        ' Jumps to next Shift Loop
        
    Next DayCt                              ' Jumps to next Day Loop after all shift loops have been run
    
    ' Set Range then Delete existing data in Monday Shift Morning Temp Data'
    ' ------------------------------------------------'
    Set wkrng = ws.Range("C60:M69")         ' Set wkrng to equal the Temp Data Range to work within
    wkrng.ClearContents                     ' Delete any values in Day1 Morning Shift to be used as the template for the rest of sheet
    ColOV = 0                               ' Reset Column Offset to 0
        
    ' Loop through Temp Names from each Shift
    ' ------------------------------------------------'
        For ShiftCt = 0 To 4                ' 5 Shifts, starts with 0 so the first runthrough offset will equal 0


            RowOV = ShiftCt * 72            ' 72 is the offset from one shift to the next
            
            wkrng.Offset(RowOV, ColOV).Select                   ' Select command for debugging purposes only
            wkrng.Offset(RowOV, ColOV).Value = wkrng.Value      ' Transfers blank cells to current offset values
            
        Next ShiftCt                        ' Jumps to next Shift Loop
    
    ' Set Range then Delete existing data in whole Copied Data Section'
    ' ------------------------------------------------'
    Set wkrng = ws.Range("IS10:KK366")      ' Set wkrng to equal the Copied Data Range to Delete Existing Data
    wkrng.ClearContents                     ' Delete any values in Day1 Morning Shift to be used as the template for the rest of sheet
        
Range("A1").Select                          'Home/ Back to top
    
End Sub

Sub PopulateTemplateMacro()
' ------------------------------------------------'
' This Macro is designed to Transfer all the Data'
' within the Shift Bid Sheet to the Template Sheet'
' ------------------------------------------------'
'
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet


Application.ScreenUpdating = False


'Transfer Shift Bid Data to Template Sheet'
'==================================================='
    'Set Selected Workbook/Worksheet'
    Set wb1 = ActiveWorkbook
    Set ws1 = wb1.Sheets("Shift Bid")
    Set ws2 = wb1.Sheets("TemplateSheet")
        ws2.Activate
    
    'Transfer Shift Bid Data'
    Application.StatusBar = "Transferring Shift Bid Data"
        ws2.Range("IS9:IU366").Value = ws1.Range("C9:E366").Value    ' Names'
        ws2.Range("IV9:JA366").Value = ws1.Range("AB9:AG366").Value  ' Mon'
        ws2.Range("JB9:JG366").Value = ws1.Range("AR9:AW366").Value  ' Tue'
        ws2.Range("JH9:JM366").Value = ws1.Range("BH9:BM366").Value  ' Wed'
        ws2.Range("JN9:JS366").Value = ws1.Range("BX9:CC366").Value  ' Thu'
        ws2.Range("JT9:JY366").Value = ws1.Range("CN9:CS366").Value  ' Fri'
        ws2.Range("JZ9:KE366").Value = ws1.Range("DD9:DI366").Value  ' Sat'
        ws2.Range("KF9:KK366").Value = ws1.Range("DT9:DY366").Value  ' Sun'
        ws1.Activate
        Range("A1").Select 'Home'
    
    ' Home Both Sheets'
    Range("G9").Select
        ws1.Activate
    Range("G9").Select
'==================================================='
    
Application.ScreenUpdating = True
    
End Sub

 

[svendiamond]

Just glancing through your code the most obvious opportunities I see are the overuse of "select" -- rarely should you have to use "select" in your code:

====================================

Sheets(Sheets.Count).Select
ShtName = ActiveSheet.Name

could be shortened to:

ShtName = Sheets(Sheets.Count).Name

====================================

Range("B2").Select ' Select Name of Sheet Title'
ActiveCell.FormulaR1C1 = "Week " & WkName & " A-Schedule" ' Change Name of Sheet Title'

could be shortened to:

Range("B2").Value = "Week " & WkName & " A-Schedule"

====================================

You should also try to stay away from "Goto":

If AutoBuild = "yes" Then GoTo SkpMsg2
        If MsgBox("Done", vbOKOnly) = vbOK Then
        End If
SkpMsg2:

could be changed to:

If AutoBuild <> "yes" Then
    If MsgBox("Done", vbOKOnly) = vbOK Then
        End If
End If

=====================================

 

[DuncanC66]

Thanks that's just the type of reply I was looking for. However I don't really know what I would do in this case to avoid it?

Can you give me an example?
Once I get an example I can transfer it to the code and possibly start thinking about it another way.

 

[svendiamond]

Thanks that's just the type of reply I was looking for. However I don't really know what I would do in this case to avoid it?

Can you give me an example?
Once I get an example I can transfer it to the code and possibly start thinking about it another way.

I gave you three examples...

 

[DuncanC66]

Doh I was looking at it on my phone couldn't see the examples thanks so much!

 

[DuncanC66]

The main reason why I use .select is for when I am troubleshooting.

If I start up the sub then put a stop at the point where I want to check I can actually see that Cell A1 has been selected and that the code is where I think it is supposed to be.

Would the examples you gave above actually select any of the cells it was changing?
How would you go about checking to see if it is working correctly?

I see the logic with the GoTo statement, but why not use it?
Just an extra line? Or is there something inherently wrong with that command?

Is there a hard and fast rule as to what you can qualify a command with.
Can I always Qualify a command with Workbook name?
Can I always Qualify a command with Worksheet name?
WB1.WS1.Range("A1").value

Is there a good list of all commands and what can be used a qualifiers or suffixes?
I guess as a Self-Taught coder I missed that lesson.

 

[svendiamond]

1. The examples above would copy and paste without selecting... save a back-up of your workbook, then try out the code and you'll see.

2. Goto is usually frowned upon in programming as it can lead to "spaghetti" code where the code jumps up and down and all around -- one Goto is not a huge deal but there are just better ways to write code.

3. You can always go from biggest to smallest. I strongly recommend watching this tutorial video, it is short and very helpful: https://www.youtube.com/watch?v=c8reU-H1PKQ&list=PLNIs-AWhQzckr8Dgmgb3akx_gFMnpxTN5&index=5

4. You can open the Object Browser in the VB Editor (View > Object Browser) and then click on a class (such as "Range") to see all the different commands you can use on it.

 

[John_w]

How would you go about checking to see if it is working correctly?

Use the Range.Address property to verify that the code is referencing the correct cell(s):

            Debug.Print wkrng.Offset(RowOV, ColOV).Address      ' Outputs cell/range address to Immediate window
            wkrng.Offset(RowOV, ColOV).Value = wkrng.Value      ' Transfers blank cells to current offset values

 

[Michael M]

you can also step through manually and see the actions 1 step after they have been executed

 

[DuncanC66]

I do use the step through.
But if I'm not using select the command then the focus doesn't move to that cell.
I suppose I could manually look at each cell to if it has changed.