79520188

Date: 2025-03-19 12:31:16
Score: 0.5
Natty:
Report link

Thanks to CDP1802 contribution. I've followed and used his code as a template. I have some constrains. It's part of an small accountant system where both income and expenses are displayed on same sheet. Therefore I couldn't test against 1 or first Row, but I said if the header/total ain't shown up within 3 rows, the I will break. My test criteria if it's a header row, all columns has to have content. My test criteria for total row is that it different from a totally empty row. Some of the rows are not completely empty outside of the "Range" of the table, therefore I a little bit stubborn :-)) and use only first column to last column of the table and offset that with a certain amount of rows like this

Private Function CorrectRangeForHeaderRows(rRng As Range) As Range
  'rRng.Select
  Dim tmpRng As Range
  Set tmpRng = rRng.Range(Cells(1, 1), Cells(1, rRng.Columns.Count))
  'tmpRng.Select

  'Loop to a full Header row
  Dim lCor As Long: lCor = 1
  Do While WorksheetFunction.CountA(tmpRng.Offset(-lCor)) < rRng.Columns.Count
    lCor = lCor + 1
    If rRng.Row - lCor <= 1 Then
      Exit Do
    End If
  Loop
  If rRng.Row - lCor > 1 Then
    Set rRng = rRng.Offset(-lCor).Resize(rRng.Rows.Count + lCor)
  End If
  'rRng.Select
  CorrectRangeForHeaderRows = rRng
End Function
Private Function CorrectForTotalRow(rRng As Range) As Range
  'rRng.Select
  Dim tmpRng As Range
  Set tmpRng = rRng.Range(Cells(1, 1), Cells(1, rRng.Columns.Count))
  'tmpRng.Select

  Dim lCor As Long: lCor = rRng.Rows.Count
  Do While WorksheetFunction.CountA(tmpRng.Offset(lCor)) = 0
    lCor = lCor + 1
    If lCor > rRng.Rows.Count + 2 Then
      Exit Do
    End If
  Loop
  If lCor <= rRng.Rows.Count + 2 Then
    Set rRng = rRng.Resize(lCor + 1)
  End If
  'rRng.Select
   CorrectForTotalRow = rRng
End Function
Reasons:
  • Blacklisted phrase (0.5): Thanks
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (1):
Posted by: Jo-Helge Rorvik