Tidying up code

[trobb]

Hi,

I have copied together some code on the internet to practice some VBA. The code below gets the job done but it is very long and I am pretty sure it can be cut down. I have tried to shorten it but I have not a clue. I have this sum line of code that adds up fields that are returned when I select a certain sales rep.

to shorten the code I need to do something like this (doesn't work) so I can format the sheet in code rather than repeating it for J,K,L,N,M,O,P and Q.

[ThisWorkbook.Sheets("Sheet1").Range("J,K,L,N,M,O,P,Q" & lastrow + 1)]



If someone could help me be more succinct that would be great!!

spreadsheet attached if that helps.

Here is the code that I have. It returns the values from a dataset I have and returns a little report based on the rep name I select. I then try and add a total line totaling the numbers and putting a dash in where there aren't numbers.

Sub finddata()

Dim repname As String
Dim finalrow As Integer
Dim i As Integer

Sheets("Sheet1").Range("J6:Q50").ClearContents
Sheets("Sheet1").Range("J6:Q50").Font.Bold = False
Sheets("Sheet1").Range("J6:Q50").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

repname = Sheets("Sheet1").Range("L3").Value
finalrow = Sheets("Sheet1").Range("C5000").End(xlUp).Row

For i = 3 To finalrow
    If Cells(i, 3) = repname Then
    Range(Cells(i, 1), Cells(i, 7)).Copy
    Range("K50").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    End If
    
Next i

lastrow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 15).End(xlUp).Row

ThisWorkbook.Sheets("Sheet1").Range("J" & lastrow + 1) = "Total"
ThisWorkbook.Sheets("Sheet1").Range("J" & lastrow + 1).Font.Bold = True

With ThisWorkbook.Sheets("Sheet1").Range("J" & lastrow + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ThisWorkbook.Sheets("Sheet1").Range("J" & lastrow + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

ThisWorkbook.Sheets("Sheet1").Range("o" & lastrow + 1) = WorksheetFunction.Sum(ThisWorkbook.Sheets("Sheet1").Range("O6:O" & lastrow))
ThisWorkbook.Sheets("Sheet1").Range("o" & lastrow + 1).Font.Bold = True
ThisWorkbook.Sheets("Sheet1").Range("O" & lastrow + 1).VerticalAlignment = xlCenter

With ThisWorkbook.Sheets("Sheet1").Range("O" & lastrow + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ThisWorkbook.Sheets("Sheet1").Range("O" & lastrow + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

ThisWorkbook.Sheets("Sheet1").Range("K" & lastrow + 1) = "-"
ThisWorkbook.Sheets("Sheet1").Range("K" & lastrow + 1).HorizontalAlignment = xlCenter
ThisWorkbook.Sheets("Sheet1").Range("K" & lastrow + 1).VerticalAlignment = xlCenter
ThisWorkbook.Sheets("Sheet1").Range("K" & lastrow + 1).Font.Bold = True

With ThisWorkbook.Sheets("Sheet1").Range("K" & lastrow + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ThisWorkbook.Sheets("Sheet1").Range("K" & lastrow + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

ThisWorkbook.Sheets("Sheet1").Range("L" & lastrow + 1) = "-"
ThisWorkbook.Sheets("Sheet1").Range("L" & lastrow + 1).HorizontalAlignment = xlCenter
ThisWorkbook.Sheets("Sheet1").Range("L" & lastrow + 1).VerticalAlignment = xlCenter
ThisWorkbook.Sheets("Sheet1").Range("L" & lastrow + 1).Font.Bold = True

With ThisWorkbook.Sheets("Sheet1").Range("L" & lastrow + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ThisWorkbook.Sheets("Sheet1").Range("L" & lastrow + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

ThisWorkbook.Sheets("Sheet1").Range("M" & lastrow + 1) = "-"
ThisWorkbook.Sheets("Sheet1").Range("M" & lastrow + 1).HorizontalAlignment = xlCenter
ThisWorkbook.Sheets("Sheet1").Range("M" & lastrow + 1).VerticalAlignment = xlCenter
ThisWorkbook.Sheets("Sheet1").Range("M" & lastrow + 1).Font.Bold = True

With ThisWorkbook.Sheets("Sheet1").Range("M" & lastrow + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ThisWorkbook.Sheets("Sheet1").Range("M" & lastrow + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

ThisWorkbook.Sheets("Sheet1").Range("N" & lastrow + 1) = "-"
ThisWorkbook.Sheets("Sheet1").Range("N" & lastrow + 1).HorizontalAlignment = xlCenter
ThisWorkbook.Sheets("Sheet1").Range("N" & lastrow + 1).VerticalAlignment = xlCenter
ThisWorkbook.Sheets("Sheet1").Range("N" & lastrow + 1).Font.Bold = True

With ThisWorkbook.Sheets("Sheet1").Range("N" & lastrow + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ThisWorkbook.Sheets("Sheet1").Range("N" & lastrow + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

ThisWorkbook.Sheets("Sheet1").Range("P" & lastrow + 1) = WorksheetFunction.Sum(ThisWorkbook.Sheets("Sheet1").Range("P6:P" & lastrow))
ThisWorkbook.Sheets("Sheet1").Range("P" & lastrow + 1).Font.Bold = True
ThisWorkbook.Sheets("Sheet1").Range("P" & lastrow + 1).VerticalAlignment = xlCenter

With ThisWorkbook.Sheets("Sheet1").Range("P" & lastrow + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ThisWorkbook.Sheets("Sheet1").Range("P" & lastrow + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With

ThisWorkbook.Sheets("Sheet1").Range("Q" & lastrow + 1) = WorksheetFunction.Sum(ThisWorkbook.Sheets("Sheet1").Range("Q6:Q" & lastrow))
ThisWorkbook.Sheets("Sheet1").Range("Q" & lastrow + 1).Font.Bold = True
ThisWorkbook.Sheets("Sheet1").Range("Q" & "R" & "S" & lastrow + 1).VerticalAlignment = xlCenter

With ThisWorkbook.Sheets("Sheet1").Range("Q" & lastrow + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ThisWorkbook.Sheets("Sheet1").Range("Q" & lastrow + 1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With


Columns("J:Q").EntireColumn.AutoFit

    Application.CutCopyMode = False
    Range("L3").Select

End Sub

Thanks

[jindon]

See if this is how you wanted.
Used AdvancedFilter instead of loop.

Sub finddata()
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
        .Range("J5:Q50").Clear
        .Range("i2").Formula = "=c3=l$3"
        With .Range("a2").CurrentRegion
            .AdvancedFilter 2, .Parent.Range("i1:i2"), .Parent.Range("k5")
        End With
        With .Range("k5").CurrentRegion
            .Borders.LineStyle = xlNone
            .Interior.ColorIndex = xlNone
            .Offset(1).Font.Bold = False
            With .Rows(.Rows.Count + 1)
                With .Offset(, -1).Resize(, .Columns.Count + 1)
                    .HorizontalAlignment = xlCenter
                    .Font.Bold = True
                    .Borders(3).Weight = 2
                    .Borders(9).LineStyle = xlDouble
                    .Cells(1).Resize(, 5).Value = Array("Total", "-", "-", "-", "-")
                    .Cells(, 6).Resize(, 3).FormulaR1C1 = "=sum(r6c:r[-1]c)"
                    .EntireColumn.AutoFit
                End With
            End With
        End With
        .Range("i2").Clear
    End With
    Application.ScreenUpdating = True
End Sub

[MarvinP]

Hi trobb,

This problem can be done without any VBA or advanced filters. See the attached that gives a Pivot Table answer. You need to format the Pivot Table to not show subtotals and in Tabular format. You then simply filter by the Rep. See the attached. No VBA needed!! Note: I guess I'm just lazy and want to use the easy method for doing these things, and I do write VBA.

PT instead of VBA.xlsm

[jindon]

trobb

Thanks for the rep.