Removing redundant code

[USN_Hobby]

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

[Aussiebear]

Have you considered simply filtering your data and printing?

[jdelano]

It looks like just the title is changing in these procedures, you can pass the title into it and just have one:


Sub RunReport(ReportTitle as String, ReportFilter as String)


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 &U" & ReportTitle & " " & Format(Now(), "dd mmmm yyyy&B &U")


RecallHeader
Sort_LastName


For i = 2 To lrowIn
If Len(ReportFilter) = 0 or wsIn.Range("E" & i).Text = ReportFilter 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


Just call RunReport with whatever title you want displayed and the filter to apply when looping. Your case statement would look something like



Select Case rdobutton
Case rdoRecallReport
RunReport("COMMAND RECALL REPORT","")

Case rdoExecutiveDept
RunReport("EXECUTIVE DEPARTMENT RECALL REPORT","EXECUTIVE")

End Select


and so on for each of the variants you need.
edit: formating

[USN_Hobby]

Thank You so much, that worked amazing!

one note:

this threw a compile error, took a minute to figure out that it should


RunReport("EXECUTIVE DEPARTMENT RECALL REPORT","EXECUTIVE")


look like this:


RunReport "EXECUTIVE DEPARTMENT RECALL REPORT", "EXECUTIVE"

[jdelano]

You're welcome, eh, yeah sorry. I ALWAYS forget that VBA doesn't require the parentheses