0

enter image description here

The below macro runs through by searching the sub-ledger header and sum the values below the header. If there is no value below the third search under Sub-Ledger header, how we need to skip and go ahead with processing the macro.

I have added the snapshot where the third column Sub-Ledger Header has no values below and we couldn't able to total the single blank cell using the code below.

Sub FACP_REPORTS()
    Dim sFirst As Range, st1 As Range
    Dim sSecond As Range, st2 As Range
    Dim A As Range
    Dim B As Range
    Dim Sumtotal As Variant
    
    Application.DisplayAlerts = False
    Sheets("FA_CP_Report").Select
    Range("A1").Select
    Set A = Range("F:G")
    Set B = Range("G:H")
   Do
      If sFirst Is Nothing Then
         Set sFirst = A.Find(What:="Sub-ledger")
         Set st1 = sFirst
      Else
         Set st1 = A.Find(What:="Sub-ledger", After:=st1)
         If st1.Address = sFirst.Address Then Exit Do
      End If
         st1.Select
            Selection.End(xlDown).Select
            Range(ActiveCell, ActiveCell.End(xlDown)).Select
            Sumtotal = Application.WorksheetFunction.Sum(Selection)
            Selection.End(xlDown).Offset(2, 0).Select
            ActiveCell.Value = Sumtotal
            Selection.NumberFormat = "0.00"
            Selection.Style = "Comma"
            ActiveCell.Font.Bold = True
            ActiveCell.Interior.ColorIndex = 27
            ActiveCell.Borders.LineStyle = xlContinuous
    Loop
    Application.DisplayAlerts = True
End Sub
  • I saw a big problem in your code, but I don't how to fix it, for me the entire code does not make sense.... – Kin Siang Jun 10 '21 at 01:47
  • 1
    First things first: your code will be _much_ easier to follow and debug (and faster) if you don't use [Select/Selection and Implicit ActiveSheet](https://stackoverflow.com/q/10714251) – chris neilsen Jun 10 '21 at 01:59
  • 1
    Given your codes relaince on `.End`, some sample data and your expected result are essential in diagnosing your issues. Please undate your Q by editing in a small representitive data set (as text), together with your expected results for that sample – chris neilsen Jun 10 '21 at 02:09
  • Which are the alerts you are so keen to suppress that you do it before all else? Normally, alerts are useful to help avoid regrettable and costly mistakes. Are you so sure of your code that you can disregard advice - before all else? – Variatus Jun 10 '21 at 02:46

1 Answers1

0

It's hard to determine from your code what kind of layout you have in your worksheet. So, this is the layout I created.

Result

An this is the code that produced the result in column I. The main difference from your own effort is the use of FindNext. I think you will find it easier to modify, if needed.

Sub FACP_REPORTS()
    ' 260

    Dim Rng         As Range            ' range to find "Sub-ledger" in
    Dim Fnd         As Range            ' "Sub-ledger" found
    Dim FirstFound  As Long             ' row of first found "Sub-ledger"
    Dim SumRng      As Range            ' range to sum up
    
    With Worksheets("FA_CP_Report")
        Set Rng = .Columns(7)
        Set Fnd = Rng.Find("Sub-ledger", Rng.Cells(.Rows.Count), _
                           LookIn:=xlValues, LookAt:=xlWhole)
        If Not Fnd Is Nothing Then
            FirstFound = Fnd.Row
            Do
                ' start 1 row below "Sub-ledger" in the adjacent column
                Set SumRng = .Cells(Fnd.Row + 1, Fnd.Column + 1)
                Set SumRng = .Range(SumRng, SumRng.End(xlDown))
                
                ' the cell to the right of the last item in sub-ledger
                With SumRng.Cells(SumRng.Cells.Count).Offset(0, 1)
                    .Value = WorksheetFunction.Sum(SumRng)
                    .NumberFormat = "0.00"
                    .Style = "Comma"
                    .Interior.ColorIndex = 27
                    .Borders.LineStyle = xlContinuous
                End With
                
                Set Fnd = Rng.FindNext(Fnd)
                If Fnd Is Nothing Then Exit Do
            Loop While Fnd.Row > FirstFound
        End If
    End With
End Sub
Variatus
  • 14,293
  • 2
  • 14
  • 30