I am getting an Error 13 in a VBA routine that I can't figure out. I am opening an excel template. The tab in the template has been named. In my routine I getting this mismatch error. Ususally when I have received this error in the past it is because I have set a variable up as text when it has a number in it. That isn't the case here. I am hoping that someone can point out the error of my ways. Any help is greatly appreciated. When the code is stopped and I hover over rstProv![PROV]) I see the name that I am expecting. It is the same name that is on the tab on the open worksheet.
The error is happening on the red highlighted area.
The error is happening on the red highlighted area.
Code:
Private Sub cmdXL_Click()
Dim strSaveFile As String
Dim strMonth As String
Dim liPd As Long
Dim strSQL As String
Dim rstProv As Recordset
Dim liProvID As Long
Dim rstData As Recordset
Dim X As Integer
Dim Y As Integer
Dim iRow As Integer
strMonth = GetCurMonth()
liPd = GetCurPd()
strSQL = "SELECT prvnum,PROV " & _
"FROM RPT_DATA " & _
"GROUP BY prvnum,PROV " & _
"ORDER BY PROV DESC;"
Set rstProv = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If Not rstProv.EOF Then
With rstProv
.MoveLast
.MoveFirst
End With
Call XLCreate
goXL.Workbooks.Add
For X = 1 To rstProv.RecordCount
iRow = 6
With goXL
.ActiveWorkbook.Sheets.Add
.ActiveSheet.Name = (rstProv![PROV])
End With
liProvID = rstProv![prvnum]
Call PrepareSheet
Call SetTitle(rstProv![PROV], strMonth)
strSQL = "SELECT CPT,CPTDESC,Sum(UNITS) AS yru, Sum(CHG_AMT) AS yrc " & _
"FROM RPT_DATA " & _
"WHERE (prvnum=" & (liProvID) & ") " & _
"GROUP BY CPT,CPTDESC " & _
"ORDER BY CPT;"
Set rstData = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If Not rstData.EOF Then
With rstData
.MoveLast
.MoveFirst
End With
' Add Data
For Y = 1 To rstData.RecordCount
With goXL.ActiveSheet
.Cells(iRow, 1).Value = rstData![CPT]
.Cells(iRow, 2).Value = rstData![CPTDESC]
.Cells(iRow, 3).Value = GetMthUnits(liProvID, liPd, rstData![CPT])
.Cells(iRow, 4).Value = GetMthChgs(liProvID, liPd, rstData![CPT])
.Cells(iRow, 5).Value = rstData![yru]
.Cells(iRow, 6).Value = rstData![yrc]
End With
rstData.MoveNext
iRow = iRow + 1
Next Y
' Add Totals
Call XLFormatBottomLine(iRow, 1, 6)
With goXL.ActiveSheet
.Cells(iRow + 1, 2).Value = "TOTALS:"
.Cells(iRow + 1, 3).Formula = "=SUM(C" & (iRow) & ":C6)"
.Cells(iRow + 1, 4).Formula = "=SUM(D" & (iRow) & ":D6)"
.Cells(iRow + 1, 5).Formula = "=SUM(E" & (iRow) & ":E6)"
.Cells(iRow + 1, 6).Formula = "=SUM(F" & (iRow) & ":F6)"
End With
Call XLFormatRight(iRow + 1, iRow + 1, 2, 2)
Call XLFormatFontBold(iRow + 1, iRow + 1, 2, 6)
Call XLFormatNumberComma(6, iRow + 1, 3, 6)
Call XLFormatCenter(6, iRow, 1, 1)
Call XLFormatBottomLine(iRow + 1, 3, 6)
End If
rstData.Close
Set rstData = Nothing
' Print Settings
[Red] With goXL.Sheets(rstProv![PROV]) [/Red]
.PageSetup.PrintArea = "$A$1:$F$" & (iRow + 1)
.PageSetup.Orientation = xlPortrait
.PageSetup.Zoom = 55
.Cells(1, 1).Select
End With
' Next Provider
rstProv.MoveNext
Next X
strSaveFile = "HMF_" & (strMonth) & "_ProviderReport.xls"
With goXL.ActiveWorkbook
.SaveAs Filename:="\\amsdc\Public\Client Services\Automate\Rpts\HMF\Adhoc\" & (strSaveFile)
.Close
End With
goXL.Workbooks.Add
' *** CPT 95951 Provider Totals Summary
With goXL
.ActiveWorkbook.Sheets.Add
.ActiveSheet.Name = "CPT 95951 Summary"
End With
Call PrepareSheet2
With goXL.ActiveSheet
.Cells(1, 1).Value = "CPT 95951 - ACTIVITY BY PROVIDER"
.Cells(3, 1).Value = "PROVIDER"
.Cells(3, 2).Value = "TOTAL"
.Cells(3, 3).Value = "OCT"
.Cells(3, 4).Value = "NOV"
.Cells(3, 5).Value = "DEC"
.Cells(3, 6).Value = "JAN"
.Cells(3, 7).Value = "FEB"
.Cells(3, 8).Value = "MAR"
.Cells(3, 9).Value = "APR"
.Cells(3, 10).Value = "MAY"
.Cells(3, 11).Value = "JUN"
.Cells(3, 12).Value = "JUL"
.Cells(3, 13).Value = "AUG"
.Cells(3, 14).Value = "SEP"
End With
strSQL = "SELECT d.prvnum,d.PROV,p.ord,Sum(d.UNITS) as proc " & _
"FROM RPT_DATA d INNER JOIN [_FiscalYear] p on d.pd = p.pd " & _
"WHERE d.CPT='95951' " & _
"GROUP BY d.prvnum,d.PROV,p.ord " & _
"ORDER BY d.PROV,p.ord;"
Set rstData = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If Not rstData.EOF Then
With rstData
.MoveLast
.MoveFirst
End With
iRow = 4
liProvID = (rstData![prvnum])
For X = 1 To rstData.RecordCount
With goXL.ActiveSheet
.Cells(iRow, 1).Value = (rstData![PROV])
.Cells(iRow, 2).Formula = "=SUM(C" & (iRow) & ":N" & (iRow) & ")"
.Cells(iRow, (rstData![ord] + 2)).Value = (rstData![proc])
End With
rstData.MoveNext
If Not rstData.EOF Then
If (liProvID <> (rstData![prvnum])) Then
iRow = iRow + 1
liProvID = (rstData![prvnum])
End If
End If
Next X
End If
rstData.Close
Set rstData = Nothing
' Add Totals
iRow = iRow + 1
With goXL.ActiveSheet
.Cells(iRow, 1).Value = "TOTALS:"
.Cells(iRow, 2).Formula = "=SUM(C" & (iRow) & ":N" & (iRow) & ")"
.Cells(iRow, 3).Formula = "=SUM(C4:C" & (iRow - 1) & ")"
.Cells(iRow, 4).Formula = "=SUM(D4:D" & (iRow - 1) & ")"
.Cells(iRow, 5).Formula = "=SUM(E4:E" & (iRow - 1) & ")"
.Cells(iRow, 6).Formula = "=SUM(F4:F" & (iRow - 1) & ")"
.Cells(iRow, 7).Formula = "=SUM(G4:G" & (iRow - 1) & ")"
.Cells(iRow, 8).Formula = "=SUM(H4:H" & (iRow - 1) & ")"
.Cells(iRow, 9).Formula = "=SUM(I4:I" & (iRow - 1) & ")"
.Cells(iRow, 10).Formula = "=SUM(J4:J" & (iRow - 1) & ")"
.Cells(iRow, 11).Formula = "=SUM(K4:K" & (iRow - 1) & ")"
.Cells(iRow, 12).Formula = "=SUM(L4:L" & (iRow - 1) & ")"
.Cells(iRow, 13).Formula = "=SUM(M4:M" & (iRow - 1) & ")"
.Cells(iRow, 14).Formula = "=SUM(N4:N" & (iRow - 1) & ")"
End With
' Format Report
Call XLFormatFontBold(1, 3, 1, 14)
Call XLFormatFontBold(iRow, iRow, 1, 14)
Call XLFormatBottomLine(3, 1, 14)
Call XLFormatBottomLine(iRow - 1, 1, 14)
Call XLFormatCenter(3, 3, 1, 14)
Call XLFormatRight(iRow, iRow, 1, 1)
Call XLFormatLeftLine(2, 3, iRow)
Call XLFormatLeftLine(3, 3, iRow)
' Print Settings
With goXL.Sheets("CPT 95951 Summary")
.PageSetup.PrintArea = "$A$1:$N$" & (iRow)
.PageSetup.Orientation = xlLandscape
.PageSetup.Zoom = 55
.Cells(1, 1).Select
End With
' Save File and Close Excel
strSaveFile = "HMF_" & (strMonth) & "_CPT_95951_Summary.xls"
goXL.ActiveWorkbook.SaveAs Filename:="\\amsdc\Public\Client Services\Automate\Rpts\HMF\Adhoc\" & (strSaveFile)
Call XLKill
End If
rstProv.Close
Set rstProv = Nothing
End Sub