Having formatting issues - Have to bold a line with the word "Total"

[amrita17170909]

Hi All,

I have created a table which copies the values from a pivot chart and copies it on to a sheet using the below code:

Public Sub PBL_SUB_Copy_table_1() ' Step 2 Copies the pivot chart created in Table 1 to Table 2
    
    Application.DisplayAlerts = False
    
    If SheetExists("Table 1") Then
        Sheets("Table 1").Delete
    End If
  
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Table 1"
 
    Sheets("PivotTable3").Select
    Sheets("PivotTable3").UsedRange.copy
    

    Worksheets("Table 1").Activate
         Worksheets("Table 1").Range("A1").PasteSpecial xlPasteValues
          
     If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
       Application.DisplayAlerts = True
       
       
    With Sheets("Table 1")
  
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  
    fSumRow = 2
    
    While lSumRow < LastRow
     lSumRow = .Range("A" & fSumRow).End(xlDown).Row
  
       For ctr = fSumRow To lSumRow
                .Range("AC" & ctr).Formula = "=SUM($G" & ctr & ":$J" & ctr & ")"
                .Range("AD" & ctr).Formula = "=SUM($G" & ctr & ":$AB" & ctr & ")"
       Next ctr
    
      fSumRow = lSumRow + 3 'condition to bring out of the loop
           
      Wend
  End With

       
End Sub

I would also to include an if statement or a case statement to eliminate any 0's , (blanks) and #N/A

The next I use the below code to format the report.

The issue is that in Column C I have calculated sub-totals which when the below code is run tend to get distributed amongst the report which is not correct.

I want any row in Column C which has the word "Total" to be bold also I run a code to put the positives at the top and negatives at the bottom which should not affect the rows with the sub total.

Sub generate_report_v_4_test() ' Generates Attachment A

    Dim LastRow As Long, ctr As Long, fSumRow As Long, lSumRow As Long
    Dim SwapAry As Variant
    Dim SwapAry1 As Variant
    Dim cCel As Range
    Dim EndofBlock As Long
  
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
  
    If SheetExists("Attachment A") Then
        Sheets("Attachment A").Delete
    End If
  
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Attachment A"
  
    With Sheets("Table 1")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
      
        .Range("A2:AD" & LastRow).copy _
            Destination:=Sheets("Attachment A").Range("A6")
    End With
    
    'To delete Grand Total line incase it comes through
    With Sheets("Attachment A")
       
       LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
         If .Range("A" & LastRow) = "Grand Total" Then
          .Rows(LastRow).Delete
          
         End If
              
  
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
           
        .Columns("C").EntireColumn.Insert _
            Shift:=xlShiftToRight
  
          .Range("C" & LastRow).Offset(1).Value = UCase("total")
        
                       
        ' code to populate the positives at the top and the negatives at the bottom
        EndofBlock = LastRow
       
       ' This loop finds all the BRN and adds a blank between other BRN
        
        For ctr = LastRow To 5 Step -1
            
            If .Range("A" & ctr).Value <> .Range("A" & ctr).Offset(-1).Value Then
           
              If .Range("A" & ctr).Offset(-1).Value <> "" Then
                   
                    .Sort.SortFields.Clear
                    .Sort.SortFields.Add Key:=Range( _
                        "AE" & ctr & ":AE" & EndofBlock), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
                        xlSortNormal
                    With .Sort
                        .SetRange Range("A" & ctr & ":AE" & EndofBlock)
                        .Header = xlGuess
                        .MatchCase = False
                        .Orientation = xlTopToBottom
                        .SortMethod = xlPinYin
                        .Apply
                    End With
                    EndofBlock = ctr - 1
                   
            ' blank condition if offset -1 is blank non numeric then go to end if
                .Range(ctr & ":" & ctr + 1).EntireRow.Insert _
                    Shift:=xlShiftDown
                   
                .Range("F" & ctr).Value = UCase("total")
           
              ' Else Goto Next ctr
               End If
           
            End If
        
        Next ctr
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range( _
            "AD6:AD" & EndofBlock), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With .Sort
            .SetRange Range("A6:AD" & EndofBlock)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
               
    'The below code add the line "Total" and does formatting
     LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
       ' MsgBox (LastRow)
      
        fSumRow = 6
      
        While lSumRow < LastRow
            lSumRow = .Range("A" & fSumRow).End(xlDown).Row
                     
            .Range("H" & lSumRow + 1 & ":AE" & lSumRow + 1).Formula = "=SUM(G" & fSumRow & ":G" & lSumRow & ")"
            .Range("G" & lSumRow + 1 & ":AE" & lSumRow + 1).Interior.Color = RGB(240, 240, 240)
            .Range("G" & lSumRow + 1 & ":AE" & lSumRow + 1).Borders.LineStyle = xlContinuous
            .Range("G" & lSumRow + 1 & ":AE" & lSumRow + 1).HorizontalAlignment = xlCenter
            .Range("G" & lSumRow + 1 & ":AE" & lSumRow + 1).WrapText = True
          
            For ctr = fSumRow To lSumRow
                .Range("AC" & ctr).Formula = "=SUM($G" & ctr & ":$AA" & ctr & ")"
                .Range("AD" & ctr).Formula = "=SUM($G" & ctr & ":$AB" & ctr & ")"
               
            Next ctr

            fSumRow = lSumRow + 3 'condition to bring out of the loop
           ' MsgBox (fSumRow)
        Wend
    
    End With
    
    Call report_aesthetics_1_test
  
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub

I have included some test data to show what I am talking about :

This is how data looks when copied from :

The final output should look like below: ( I have only done the sub totals for the first customer number but it is replicated for each of the customer numbers as shown )