loop help

[justme1122]

Hi IOm having a little trouble with the below code.

Debug is show that Im getting stuck at:

Loop Until Found.Row = Lastrow

Sub Shift_Data()
    Dim Found As Range, col As Long, Lastrow As Long
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        col = 1
        Set Found = ws.Columns(col).Find("SubTotal", , xlValues, xlWhole, xlByRows, xlNext, False)
        If Not Found Is Nothing Then
            Lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row
            If Found.Row <> Lastrow Then
                Do
                    ws.Range(Found.Offset(1), ws.Cells(Lastrow, col)).Insert Shift:=xlToRight
                    col = col + 1
                    Set Found = ws.Columns(col).Find("SubTotal")
                Loop Until Found.Row = Lastrow
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Im also having a bit of trouble setting up another loop that will make the code select the next worksheet and then do the same thing over and over untill the last work sheet.

Thanks
So much for your time

scott

 

[Norie]

Scott

I think you need FindNext the instead of Find in the row just before that.

 

[justme1122]

thanks but still no luck.

Could it be posible that its having a hard time finding the last row as there is other data under the last time for the loop?