How to stop processing if no results found

This section of my script applies a filter on the dates (after converting the dots with which they are imported from SAP to slashes) and then selects the day previous today (yesterday).

These are billing dates, meaning that the invoice was generated on say day.

However, when there is no invoicing the macro freezes and takes a long time until the debug window from VBA appears. My goal is to add a line that would show a msgbox saying "No invoices were generated last day" and send it via outlook to my co-workers.

Here is my script:


Sub convertStringsToDate()
    
    Const wsName As String = "Sheet1"
    Const ColumnIndex As Variant = "G"
    Const FirstRow As Long = 2
    
    ' Define workbook.
    Dim wb As Workbook
    Set wb = Workbooks("Daily Invoiced ZAMSOTC02 LAC TEAM.xlsm") ' The workbook containing this code.
    
    ' Define worksheet.
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet 1")
    
    ' Turn off AutoFilter.
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    ' Define Column Range.
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, ColumnIndex).End(xlUp).Row
    Dim rng As Range
    Set rng = ws.Range(ws.Cells(FirstRow, ColumnIndex), _
                       ws.Cells(LastRow, ColumnIndex))
    
    ' Write values from Column Range to Data Array.
    Dim Data As Variant
    If rng.Rows.Count > 1 Then
        Data = rng.Value
    Else
        ReDim Data(1 To 1, 1 To 1)
        Data(1, 1) = rng.Value
    End If
    
    ' Convert values in Data Array, converted to strings, to dates.
    Dim CurrentValue As Variant
    Dim i As Long
    For i = 1 To UBound(Data)
        CurrentValue = DotToSlashDate(CStr(Data(i, 1)))
        If Not IsEmpty(CurrentValue) Then
            Data(i, 1) = CurrentValue
        End If
    Next
    
    ' Write dates from Data Array to Column Range.
    rng.Value = Data
    
    ' Apply AutoFilter.
    ws.Range("A1").AutoFilter Field:=7, _
                              Operator:=xlFilterDynamic, _
                              Criteria1:=xlFilterYesterday
                              
End Sub

' Converts a string in the format of either d.m.yyyy or d.m.yyyy.
' to a date in the current Excel date format.
' If the string is not in the required format, it returns empty.
Function DotToSlashDate(DotDate As String) As Variant
    On Error GoTo ProcExit
    Dim fDot As Long
    fDot = InStr(1, DotDate, ".")
    Dim dDay As String
    dDay = Left(DotDate, fDot - 1)
    Dim sDot As Long
    sDot = InStr(fDot + 1, DotDate, ".")
    Dim mMonth As String
    mMonth = Mid(DotDate, fDot + 1, sDot - fDot - 1)
    Dim yYear As String
    yYear = Replace(Right(DotDate, Len(DotDate) - sDot), ".", "")
    DotToSlashDate = DateSerial(CLng(yYear), CLng(mMonth), CLng(dDay))
ProcExit:
End Function```

I have reviewed these answers and topics, but the solution eludes me:

https://stackoverflow.com/questions/46399362/vba-output-message-box-when-autofilter-returns-no-data

Upvotes: 0

Views: 71

Answers (1)

KacireeSoftware
KacireeSoftware

Reputation: 808

I added the mod I recommended into your procedure and tested it. When you call .SpecialCells(xlCellTypeVisible).Rows.Count and no cells match the filter, an error is raised. So I added On Error Resume Next just prior to executing the line of code, and I added a long integer variable to hold the count. If nothing matches the filter, an error gets ignored and the long integer equals 0 since long integers initialize to a value of zero by default.

Note also that your original code ignored the constant [wsName]. I repaired that, so if your worksheet name is not Sheet1 then you need to correct it in the constant definition:

Set ws = wb.Worksheets("Sheet 1") ' Original Code
Set ws = wb.Worksheets(wsName) ' Modified Code

Here is the modified code:

    Sub convertStringsToDate()
        
        Const wsName As String = "Sheet1"
        Const ColumnIndex As Variant = "G"
        Const FirstRow As Long = 2
    
        ' Define workbook.
        Dim wb As Workbook
        Set wb = Workbooks("Daily Invoiced ZAMSOTC02 LAC TEAM.xlsm") ' The workbook containing this code.
        
        ' Define worksheet.
        Dim ws As Worksheet
        Set ws = wb.Worksheets(wsName)
        
        ' Turn off AutoFilter.
        If ws.AutoFilterMode Then
            ws.AutoFilterMode = False
        End If
        
        ' Define Column Range.
        Dim LastRow As Long
        LastRow = ws.Cells(ws.Rows.Count, ColumnIndex).End(xlUp).Row
        Dim rng As Range
        Set rng = ws.Range(ws.Cells(FirstRow, ColumnIndex), _
                           ws.Cells(LastRow, ColumnIndex))
        
        ' Write values from Column Range to Data Array.
        Dim Data As Variant
        If rng.Rows.Count > 1 Then
            Data = rng.Value
        Else
            ReDim Data(1 To 1, 1 To 1)
            Data(1, 1) = rng.Value
        End If
        
        ' Convert values in Data Array, converted to strings, to dates.
        Dim CurrentValue As Variant
        Dim i As Long
        For i = 1 To UBound(Data)
            CurrentValue = DotToSlashDate(CStr(Data(i, 1)))
            If Not IsEmpty(CurrentValue) Then
                Data(i, 1) = CurrentValue
            End If
        Next
        
        ' Write dates from Data Array to Column Range.
        rng.Value = Data
        
        ' Apply AutoFilter.
        ws.Range("A1").AutoFilter Field:=7, _
                                  Operator:=xlFilterDynamic, _
                                  Criteria1:=xlFilterYesterday
        
    On Error Resume Next
        Dim xRows As Long
        xRows = rng.SpecialCells(xlCellTypeVisible).Rows.Count
        If xRows = 0 Then MsgBox "No Data in Sheet from date " & Date - 1
    ProcExit:
        'Remove Autofiltering
        If ws.AutoFilterMode Then
            ws.AutoFilterMode = False
        End If
    
    End Sub
    
    ' Converts a string in the format of either d.m.yyyy or d.m.yyyy.
    ' to a date in the current Excel date format.
    ' If the string is not in the required format, it returns empty.
Function DotToSlashDate(DotDate As String) As Variant
    On Error GoTo ProcErr
    Dim fDot As Long
    fDot = InStr(1, DotDate, ".")
    Dim dDay As String
    dDay = Left(DotDate, fDot - 1)
    Dim sDot As Long
    sDot = InStr(fDot + 1, DotDate, ".")
    Dim mMonth As String
    mMonth = Mid(DotDate, fDot + 1, sDot - fDot - 1)
    Dim yYear As String
    yYear = Replace(Right(DotDate, Len(DotDate) - sDot), ".", "")
    DotToSlashDate = DateSerial(CLng(yYear), CLng(mMonth), CLng(dDay))
ProcExit:
    Exit Function
    
ProcErr:
    Resume ProcExit
End Function

Upvotes: 1

Related Questions