Do While/ Formula Visible Cells

[Mudbutt]

I don't have a lot of experience with loops so I'm trying to figure this code out without any luck so far. I'm using Excel 2007. I have a couple filters on and have a write a date with a phrase in the top cell below the header, down 10 cells.

So I run this report every Monday, so I need to write the current day's date(Monday) with text down 10 cells, then in the 11th cell change the date to one day higher down ten cells, then one day higher for 10 cells. However, I need to only go to the last row that is showing so something could get cut off before 10 and that's fine. Another caviot is that the date can't go past Friday, the sequence needs to stop there. There could be extra blank cells below if I can reach Friday. I tried to use the resize function, but resize apparently doesn't take into consideration visible cells, and actually pastes down ten in the cells that have been filtered out. Here is what I have right now, but isn't working:

Private Sub Testt()
    Range("B1").Select
    Range(ActiveCell.Offset(1, 0), Cells(Rows.Count, ActiveCell.Column)) _
        .SpecialCells(xlCellTypeVisible)(1).Select
    
    Do While IsEmpty(ActiveCell.Offset(0, 1)) = False
    
        'Monday
        ActiveCell.Resize(10, 1).Formula = Format(Date, "m/d") & " Top Ten No WIP"
        'Tuesday
        Range("B1").End(xlDown).Offset(1, 0).Resize(10, 1).Formula = _
            Format(Date + 1, "m/d") & " Top Ten No WIP"
        'Wednesday
        Range("B1").End(xlDown).Offset(1, 0).Resize(10, 1).Formula = _
            Format(Date + 2, "m/d") & " Top Ten No WIP"
        'Thursday
        Range("B1").End(xlDown).Offset(1, 0).Resize(10, 1).Formula = _
            Format(Date + 3, "m/d") & " Top Ten No WIP"
        'Friday
        Range("B1").End(xlDown).Offset(1, 0).Resize(10, 1).Formula = _
            Format(Date + 4, "m/d") & " Top Ten No WIP"
     
    Loop
End Sub

 

[Mudbutt]

I figured it out:

Range("B1").Select
    Range(ActiveCell.Offset(1, 0), Cells(Rows.Count, ActiveCell.Column)) _
        .SpecialCells(xlCellTypeVisible)(1).Select
    JK = 0
    Do While IsEmpty(ActiveCell.Offset(0, 1)) = False And JK < 10
        
        
    'Monday
        ActiveCell.Formula = Format(Date, "m/d") & " Top Ten No WIP"
        Range(ActiveCell.Offset(1, 0), Cells(Rows.Count, ActiveCell.Column)) _
        .SpecialCells(xlCellTypeVisible)(1).Select
        JK = JK + 1
    Loop
    'Tuesday
    JK = 0
    Do While IsEmpty(ActiveCell.Offset(0, 1)) = False And JK < 10
        
        ActiveCell.Formula = Format(Date + 1, "m/d") & " Top Ten No WIP"
        Range(ActiveCell.Offset(1, 0), Cells(Rows.Count, ActiveCell.Column)) _
        .SpecialCells(xlCellTypeVisible)(1).Select
        JK = JK + 1
    Loop
    'Wednesday
    JK = 0
    Do While IsEmpty(ActiveCell.Offset(0, 1)) = False And JK < 10
        ActiveCell.Formula = Format(Date + 2, "m/d") & " Top Ten No WIP"
        Range(ActiveCell.Offset(1, 0), Cells(Rows.Count, ActiveCell.Column)) _
        .SpecialCells(xlCellTypeVisible)(1).Select
        JK = JK + 1
    Loop
    'Thursday
    JK = 0
    Do While IsEmpty(ActiveCell.Offset(0, 1)) = False And JK < 10
        ActiveCell.Formula = Format(Date + 3, "m/d") & " Top Ten No WIP"
        Range(ActiveCell.Offset(1, 0), Cells(Rows.Count, ActiveCell.Column)) _
        .SpecialCells(xlCellTypeVisible)(1).Select
        JK = JK + 1
    Loop
    'Friday
    JK = 0
    Do While IsEmpty(ActiveCell.Offset(0, 1)) = False And JK < 10
        ActiveCell.Formula = Format(Date + 4, "m/d") & " Top Ten No WIP"
        Range(ActiveCell.Offset(1, 0), Cells(Rows.Count, ActiveCell.Column)) _
        .SpecialCells(xlCellTypeVisible)(1).Select
        JK = JK + 1
    Loop