CODEWITHSUNDEEP
vbaexcel
Louisa Thompson
Louisa Thompson

Reputation: 97

Do Until loop need to restart on error

I have a Do Until loop in VBA.

My problem is that there is likely to be an error most days when running the macro as not all the sheets will have info on them.

When that happens I just want to start the loop again. I am assuming its not the "On Error Resume Next" I was thinking of counting the rows on the autofilter and then if it was 1 (ie only titles) starting the loop again. Just not sure how to do that.

Dim rngDates As Range 'range where date is pasted on. 'Dim strDate As String Dim intNoOfRows As Integer Dim rng As Range

Sub Dates()

Application.ScreenUpdating = False


Set rngWorksheetNames = Worksheets("info sheet").Range("a1")


dbleDate = Worksheets("front sheet").Range("f13")


Worksheets("info sheet").Activate
Range("a1").Activate

Do Until ActiveCell = ""

strSheet = ActiveCell

Set wsFiltering = Worksheets(strSheet)

intLastRow = wsFiltering.Cells(Rows.Count, "b").End(xlUp).Row

Set rngFilter = wsFiltering.Range("a1:a" & intLastRow)

With rngFilter

.AutoFilter Field:=1, Criteria1:="="

On Error Resume Next

Set rngDates = .Resize(.Rows.Count - 1, 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)


End With

With rngDates
.Value = dbleDate
.NumberFormat = "dd/mm/yyyy"

If wsFiltering.FilterMode Then
wsFiltering.ShowAllData
End If

ActiveCell.Offset(1, 0).Select

End With

Application.ScreenUpdating = True

Worksheets("front sheet").Select

MsgBox ("Dates updated")

Loop

Upvotes: 1

Views: 2994

Answers (1)

Sam
Sam

Reputation: 7313

You could check existance of data after filtering by using SUBTOTAL formula.

If Application.WorkSheetFunction.Subtotal(103,ActiveSheet.Columns(1)) > 1 Then

'There is data

Else

'There is no data (just header row)

End If

You can read about SUBTOTAL here

Rather than using the Do Until loop, consider using a For Each loop on the Worksheets Collection.

ie.

Sub ForEachWorksheetExample()

    Dim sht As Worksheet

    'go to error handler if there is an error
    On Error GoTo err

        'loop through all the worksheets in this workbook
        For Each sht In ThisWorkbook.Worksheets

            'excute code if the sheet is not the summary page
            'and if there is some data in the worksheet (CountA)
            '(this may have to be adjusted if you have header rows)
            If sht.Name <> "front sheet" And _
            Application.WorksheetFunction.CountA(sht.Cells) > 0 Then

            'do some stuff in here. Refer to sht as the current worksheet

            End If

        Next sht

    Exit Sub

err:
    MsgBox err.Description

End Sub

Also. I would recommend removing the On Error Resume Next statement. It is much better to deal detect and deal with errors rather than ignore them. It could cause strange results.

Upvotes: 1

Related Questions