Macro to show one row at a time

[mesteptoe]

If I have a table with 100 rows say 1 to 100, of which rows 5 to 100 are hidden for instance, is it possible to create a macro such that by calling the macro Row 5 is shown. But then the next time it is called Row 6 will be shown, then Row7, Row 8 etc. etc.

Thank you.

Graham

 

[jasonb75]

A crude rehash of the unhide code to insert rows, works exactly the same as the unhide sample workbook, just needs buttons reassigning to the new macro name.

Sub InsertRowAfterButton()
c = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row

For Each m In ActiveSheet.Rows
If m.Row > ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Then Exit Sub
    
    If Cells(m.Row, 1).Value = "Total" And m.Row > c Then
        Rows(m.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Exit Sub
    End If
Next
End Sub

 

[mesteptoe]

Thanks Jason

Would my Totals line (summing figures from rows above) automatically add the additional rows into the Totals formula?

Graham

 

[jasonb75]

It doesn't for me and as far as i know there is no quick way to change that using the regular formula.

It could be done by writing the formula into the macro, but with multiple sections like you have that could get messy.

Assuming for example that in B11 you have

=sum(B2:B10)

replace with

=SUM(OFFSET(B$2,,,ROWS(B$2:A11)-1))

This will count the rows in the section including the one holding the formula and sum to the previous row.

Hopefully that makes sense.

 

[mesteptoe]

Thank you Jason

In that case I may stick with the unhide rows macro because that way I can ensure the Totals row includes everything up to the last hidden row. I just need to make sure each table has sufficient hidden rows to start with.

Thank you for sorting it out for me.

Regards

Graham

 

[jasonb75]

Not one to give up to easily

Sub InsertRowAfterButton()
    ' Find location of calling button, return column A of same row
        c = Cells(ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row, 1).Address(0, 0)
    'Find next occurrence of "total" after button
        Cells.Find(What:="total", After:=Range(c), _
        LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
 
    ' insert new row
        Selection.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ' get address of new row, column A
        aRow = ActiveCell.Row
        aCol = 1
    ' cycle through formula below new row until first emty cell
        Do Until IsEmpty(Cells(aRow + 1, aCol).Value)
    ' get address of last cell in column before new row, new row and formula row
        oldrange = Cells(aRow - 1, aCol).Address(0, 0)
        insrange = Cells(aRow, aCol).Address(0, 0)
        formrange = Cells(aRow + 1, aCol).Address(0, 0)
    ' search formula for address of last cell before new row
        If InStr(Range(formrange).Formula, oldrange) Then
    ' and replace it with address of same cell in new row
            Range(formrange).Formula = Replace(Range(formrange).Formula, oldrange, insrange)
         End If
    ' next column in cycle
            aCol = aCol + 1
        Loop
End Sub

This will rewrite the formula in the total row as the new row is inserted.

I've had to work with a set of basic rules to keep it simple, covering all eventualities would take a while, at least 8 criteria checks would be needed for each formula, as opposed to just 1 used here.

As it stands, the code:-

-Only works on relative addresses, =sum($A$1:A10) works =sum($A$1:$A$10) doesn't, $ can be used before, but not after :

- Assumes that there are no padding rows between data and totals, in A11 =sum(A1:A10) works but not = sum(A1:A9)

- Assumes same column formula in column B with data in column A doesn't work.

- Assumes no blank cells in the total row, it starts in column A and stops at first blank to avoid looping to infinity.

- No array formula.

Could be changed to allow for any of those current fail criteria to work, this is first draft on a tried and it works scenario.

 

[mesteptoe]

I admire your persistance Jason. I am most grateful to you. I shall try it out.

Regards

Graham