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