Reputation: 93
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
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