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.
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.
Code:
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
Code:
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
Code:
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