USN_Hobby
11-27-2023, 01:54 AM
hello all, i have a functioning program i wrote in excel, however, my current code is very redundant, with only one line of change between the sub routines, i cannot for the life of me figure out how to remove the redundancies and make it more simple. in this example, i have 6 sub routines, the first one is a full report, the other 5 are divided by department. ***everything here works, its just not elegant*** and i have 9 total types of reports im running currently, with more requested to be added to the program. any help in this would be greatly appreciated.
for context, i use a nested select case statement to read the value of cascading radio buttons on a userform to choose which report to run based on user input.
Sub CommandRecall()Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UCOMMAND RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub ExecRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UEXECUTIVE DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "EXECUTIVE" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub OpsRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UOPERATIONS DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "OPERATIONS" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub CombatRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UOPERATIONS DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "COMBAT SYSTEMS" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub EngRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UOPERATIONS DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "ENGINEERING" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub SupplyRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UOPERATIONS DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "SUPPLY" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
for context, i use a nested select case statement to read the value of cascading radio buttons on a userform to choose which report to run based on user input.
Sub CommandRecall()Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UCOMMAND RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub ExecRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UEXECUTIVE DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "EXECUTIVE" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub OpsRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UOPERATIONS DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "OPERATIONS" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub CombatRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UOPERATIONS DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "COMBAT SYSTEMS" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub EngRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UOPERATIONS DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "ENGINEERING" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub
Sub SupplyRecall()
Set wsIn = ThisWorkbook.Sheets("Personnel")
Set wsOut = ThisWorkbook.Sheets("Report")
lrowIn = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Report").PageSetup.CenterHeader = "&16 &B &UOPERATIONS DEPARTMENT RECALL REPORT " & Format(Now(), "dd mmmm yyyy&B &U")
RecallHeader
Sort_LastName
For i = 2 To lrowIn
lrowOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsIn.Range("E" & i).Text = "SUPPLY" Then
wsIn.Range("A" & i & ":A" & i).Copy wsOut.Cells(lrowOut, 1)
wsIn.Range("D" & i & ":D" & i).Copy wsOut.Cells(lrowOut, 2)
wsIn.Range("I" & i & ":I" & i).Copy wsOut.Cells(lrowOut, 3)
wsIn.Range("P" & i & ":Q" & i).Copy wsOut.Cells(lrowOut, 4)
End If
Next i
Color_Alt_Rows Worksheets("Report").Range("A1", "E" & lrowOut)
PDFreport
End Sub