Consulting

Results 1 to 5 of 5

Thread: Removing redundant code

  1. #1

    Removing redundant code

    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

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,180
    Location
    Have you considered simply filtering your data and printing?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    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

  4. #4
    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"

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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •