Excel VBA working in Windows 7 but not working in Windows 10
I am not an SME in VBA. I understand the basics, the issue here is this code was written by a former employee. It works in Windows 7 (Using Excel Object Library 14.0) and does not work on Windows 10. I get the following error:
Run time error '9':
Subscript out of range
The error starts on line 154, but I have no idea why? It is in bold within the code..
"wkb.Sheets(2).Range("A1:J
" Avaya Total Hours")"
--------------------------
Run time error '9':
Subscript out of range
The error starts on line 154, but I have no idea why? It is in bold within the code..
"wkb.Sheets(2).Range("A1:J
" Avaya Total Hours")"
--------------------------
Private Sub CommandButton5_Click()
Dim Wb As Workbook
Dim lastTeamRow, lastGreenReportRow, lastCanvasRow As Long
Dim GreenReportArray, GreenReportHistory As Variant
Dim c As Variant
Dim callArray(0 To 1) As Variant
Dim RphTenureTotal, RphNonTenureTotal As Double
Dim appExcel As Excel.Application
Dim wkb As Workbook
Dim index1, index2 As Integer
Dim FCMCallbackTotal As Long
CommandButton5.Enabled = False
Set Wb = ThisWorkbook
With Wb.Sheets("Teams")
lastTeamRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Team = LoadTeam(ReportType.GreenReportTeam)
' create array for Green report per employee
ReDim ReportArray(1 To lastTeamRow - 1, 1 To 8)
' create array for Green Report Array
ReDim GreenReportArray(1 To 1, 1 To 16)
' populate Green Report Array date
GreenReportArray(1, 1) = Format(Wb.Sheets("RxConsult Data").Cells(2, 3).Value, "mm/dd/yyyy")
For i = 2 To lastTeamRow
ReportArray(i - 1, 1) = Team((i - 1), Message.RealName)
ReportArray(i - 1, 2) = searchReport(Wb, "RxConsult Data", "F", i, "MRR")
GreenReportArray(1, 2) = GreenReportArray(1, 2) + ReportArray(i - 1, 2)
ReportArray(i - 1, 3) = searchReport(Wb, "Inspire Data", "E", i, "Combo CMR")
If (Team((i - 1), Message.Inclusion) = 0) Then
GreenReportArray(1, 5) = GreenReportArray(1, 5) + ReportArray(i - 1, 3)
End If
ReportArray(i - 1, 4) = searchReport(Wb, "Inspire Data", "E", i, "Solo CMR")
If (Team((i - 1), Message.Inclusion) = 0) Then
GreenReportArray(1, 6) = GreenReportArray(1, 6) + ReportArray(i - 1, 4)
End If
If (Team((i - 1), Message.Inclusion) = 0 And Team((i - 1), Message.EmployeeType) = 0) Then
ReportArray(i - 1, 5) = searchReport(Wb, "Avaya Data", "B", i, "AvayaReport") 'Pharamcist total hours
GreenReportArray(1, 12) = GreenReportArray(1, 12) + ReportArray(i - 1, 5)
If (Team((i - 1), Message.Tenure) = 1) Then
RphTenureTotal = RphTenureTotal + ReportArray(i - 1, 5)
ReportArray(i - 1, 7) = searchReport(Wb, "RxConsult Data", "F", i, "MRR") 'Pharamcist MRRs for Tenured
GreenReportArray(1, 14) = GreenReportArray(1, 14) + ReportArray(i - 1, 7)
End If
If (Team((i - 1), Message.Tenure) = 0) Then
RphNonTenureTotal = RphNonTenureTotal + ReportArray(i - 1, 5)
ReportArray(i - 1, 8) = searchReport(Wb, "RxConsult Data", "F", i, "MRR") 'Pharamcist MRRs for Non-Tenured
GreenReportArray(1, 15) = GreenReportArray(1, 15) + ReportArray(i - 1, 8)
End If
End If
If (Team((i - 1), Message.Inclusion) = 0 And Team((i - 1), Message.EmployeeType) = 1) Then 'Tech total hours
ReportArray(i - 1, 6) = searchReport(Wb, "Avaya Data", "B", i, "AvayaReport")
GreenReportArray(1, 13) = GreenReportArray(1, 13) + ReportArray(i - 1, 6)
End If
Next
If (RphTenureTotal > 0) Then
GreenReportArray(1, 14) = Format((GreenReportArray(1, 14) / RphTenureTotal) * 7.5, "Standard")
Else
GreenReportArray(1, 14) = 0
End If
If (RphNonTenureTotal > 0) Then
GreenReportArray(1, 15) = Format((GreenReportArray(1, 15) / RphNonTenureTotal) * 7.5, "Standard")
Else
GreenReportArray(1, 15) = 0
End If
If (GreenReportArray(1, 12) > 0) Then
GreenReportArray(1, 16) = Format((GreenReportArray(1, 2) / GreenReportArray(1, 12)) * 7.5, "Standard")
Else
GreenReportArray(1, 16) = 0
End If
With Wb.Sheets("Canvas")
callArray(0) = 0
callArray(1) = 0
lastCanvasRow = .Range("W" & .Rows.Count).End(xlUp).Row
FCMCallbackTotal = searchReport(Wb, "Canvas", "W", i, "CALLS", callArray)
GreenReportArray(1, 8) = CInt(callArray(0)) - CInt(callArray(1)) 'Call backs converted
GreenReportArray(1, 9) = CInt(callArray(1)) 'Missed opps
End With
With Wb.Sheets("Green Report")
lastGreenReportRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 2 To lastGreenReportRow
GreenReportArray(1, 3) = GreenReportArray(1, 3) + .Cells(i, 2) 'YTD MRR
GreenReportArray(1, 7) = GreenReportArray(1, 7) + .Cells(i, 5) + .Cells(i, 6) 'YTD CMRs completed
Next
End With
GreenReportArray(1, 3) = GreenReportArray(1, 3) + GreenReportArray(1, 2)
GreenReportArray(1, 7) = GreenReportArray(1, 7) + GreenReportArray(1, 5) + GreenReportArray(1, 6) ''YTD CMRs completed
GreenReportArray(1, 4) = GreenReportArray(1, 2) - GreenReportArray(1, 8) 'Live MRR
GreenReportArray(1, 10) = Wb.Sheets("Avaya SL").Cells(3, 2).Value 'SL
GreenReportArray(1, 11) = Wb.Sheets("Avaya SL").Cells(3, 4) 'ASA
Set c = Wb.Sheets("Green Report").Range("A1" & ":" & "A" & lastGreenReportRow).Find(Format(GreenReportArray(1, 1), "mm/dd/yy"), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
MsgBox "This report day " & GreenReportArray(1, 1) & " is already present in the Green Report on row " & c.Row, vbExclamation, "Error!"
Else
If (CDate(GreenReportArray(1, 1)) > CDate(Wb.Sheets("Green Report").Cells(2, 1))) Then
Wb.Sheets("Green Report").Rows(2).Insert shift:=xlShiftDown
Wb.Sheets("Green Report").Range("A2:P2").Font.Bold = False
Wb.Sheets("Green Report").Range("A2:P2") = GreenReportArray
Wb.Sheets("Green Report").Range("A1:P" & lastGreenReportRow + 1).Sort key1:=Wb.Sheets("Green Report").Range("A:A"), order1:=xlDescending, Header:=xlYes
ReDim GreenReportHistory(1 To lastGreenReportRow + 1, 1 To 16)
GreenReportHistory = Wb.Sheets("Green Report").Range("A1" & ":" & "P" & lastGreenReportRow + 1)
Set appExcel = New Excel.Application
Set wkb = appExcel.Workbooks.Add
appExcel.Visible = False
With wkb.Sheets(1)
.Name = Format(GreenReportArray(1, 1), "mm-dd-yy")
.Range("A1" & ":" & "P" & lastGreenReportRow + 1) = GreenReportHistory
.Columns("A:P").ColumnWidth = 12
.Columns("A:P").HorizontalAlignment = xlCenter
.Columns("N:P").NumberFormat = "0.00"
.Columns("A:P").WrapText = True
With wkb.Sheets(1).Range("A2" & ":" & "P" & lastGreenReportRow + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With wkb.Sheets(1).Range("A1" & ":" & "A" & lastGreenReportRow + 1 & "," & "P1" & ":" & "P" & lastGreenReportRow + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 43
End With
With wkb.Sheets(1).Range("C2" & ":" & "C" & lastGreenReportRow + 1 & "," & "D2" & ":" & "D" & lastGreenReportRow + 1 _
& "," & "E2" & ":" & "E" & lastGreenReportRow + 1 & "," & "G2" & ":" & "G" & lastGreenReportRow + 1 _
& "," & "I2" & ":" & "I" & lastGreenReportRow + 1 & "," & "K2" & ":" & "K" & lastGreenReportRow + 1 _
).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 43
End With
End With
index1 = 2
index2 = 2
[b]wkb.Sheets(2).Range("A1:J1") = Array("Name", "Avaya Name", "Employment Type", "Tenure Type", "Inclusion Status", "Secret Code", "MRRs", "Combo CMRs", "Solo CMRs",
" Avaya Total Hours")
wkb.Sheets(2).Range("A1:J1").Font.Bold = True
wkb.Sheets(2).Range("A1:J1").HorizontalAlignment = xlCenter
wkb.Sheets(3).Range("A1:E1") = Array("Name", "Avaya Name", "Employment Type", "Inclusion Status", "Avaya Total Hours")
wkb.Sheets(3).Range("A1:E1").Font.Bold = True
wkb.Sheets(3).Range("A1:E1").HorizontalAlignment = xlCenter[/b][
For i = 2 To lastTeamRow
If (Team((i - 1), Message.EmployeeType) = 0) Then
With wkb.Sheets(2)
.Cells(index1, 1) = Team(i - 1, Message.RealName)
.Cells(index1, 2) = Team(i - 1, Message.AvayaName)
If (Team(i - 1, Message.EmploymentType) = 0) Then
.Cells(index1, 3) = "Full Time"
Else
.Cells(index1, 3) = "Part Time"
End If
If (Team(i - 1, Message.Tenure) = 1) Then
.Cells(index1, 4) = "Tenured"
Else
.Cells(index1, 4) = "Non-Tenured"
End If
If (Team(i - 1, Message.Inclusion) = 0) Then
.Cells(index1, 5) = "Included"
Else
.Cells(index1, 5) = "Excluded"
.Cells(index1, 5).Font.Bold = True
End If
.Cells(index1, 6) = Team(i - 1, Message.SecretCode) 'Secret Code
.Cells(index1, 7) = ReportArray(i - 1, 2) 'MRRs
.Cells(index1, 8) = ReportArray(i - 1, 3) 'Combo CMRs
.Cells(index1, 9) = ReportArray(i - 1, 4) 'Solo CMRs
If (ReportArray(i - 1, 5) = Empty) Then
.Cells(index1, 10) = 0 'Avaya Total Hours
If (.Cells(index1, 5) = "Excluded") Then .Cells(index1, 10).Font.Bold = True
Else
.Cells(index1, 10) = ReportArray(i - 1, 5) 'Avaya Total Hours
End If
End With
index1 = index1 + 1
End If
If (Team((i - 1), Message.EmployeeType) = 1) Then
With wkb.Sheets(3)
.Cells(index2, 1) = Team(i - 1, Message.RealName)
.Cells(index2, 2) = Team(i - 1, Message.AvayaName)
If (Team(i - 1, Message.EmploymentType) = 0) Then
.Cells(index2, 3) = "Full Time"
Else
.Cells(index2, 3) = "Part Time"
End If
If (Team(i - 1, Message.Inclusion) = 0) Then
.Cells(index2, 4) = "Included"
Else
.Cells(index2, 4) = "Excluded"
.Cells(index2, 4).Font.Bold = True
End If
If (ReportArray(i - 1, 6) = Empty) Then
.Cells(index2, 5) = 0 'Tech Avaya Total Hours
If (.Cells(index2, 4) = "Excluded") Then .Cells(index2, 5).Font.Bold = True
Else
.Cells(index2, 5) = ReportArray(i - 1, 6) 'Tech Avaya Total Hours
End If
End With
index2 = index2 + 1
End If
Next
wkb.Sheets(2).Range("A1:J" & index1).HorizontalAlignment = xlCenter
wkb.Sheets(3).Range("A1:E" & index2).HorizontalAlignment = xlCenter
wkb.Sheets(2).Range("A1:J" & index1).Columns.AutoFit
wkb.Sheets(3).Range("A1:E" & index2).Columns.AutoFit
wkb.Sheets(2).Name = "Pharmacists (" & index1 - 2 & ")"
wkb.Sheets(3).Name = "Technicians (" & index2 - 2 & ")"
appExcel.Visible = True
wkb.SaveAs Filename:=Application.ThisWorkbook.Path & "\Daily Reports Archive\" & "Green Report " & Format(GreenReportArray(1, 1), "mm-dd-yy") & ".xlsx"
Else
MsgBox "This report day " & GreenReportArray(1, 1) & " is in the past compared to the latest green report day on row 2: " & CDate(Wb.Sheets("Green Report").Cells(2, 1)), vbExclamation, "Error!"
End If
End If
Wb.Save
CommandButton5.Enabled = True
End Sub
Jan Karel Pieterse
All I can think of is that the workbook in question does not have more than 1 sheet.
ASKER
That was my first guess, but it works fine in Windows 7. I am baffled....
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Try these options:
1 - Explicitly indicate that you are setting the value on line 152: wkb.Sheets(2).Range("A1:J1
2 - Switch to using worksheet names: Sheets(2) becomes Sheets("Sheet2Name")
3 - Assign the value of wkb.Sheets(2).Range("A1:J1
1 - Explicitly indicate that you are setting the value on line 152: wkb.Sheets(2).Range("A1:J1
2 - Switch to using worksheet names: Sheets(2) becomes Sheets("Sheet2Name")
3 - Assign the value of wkb.Sheets(2).Range("A1:J1
I see. Did you try the other suggestions 1 and 3? What were your results?
I also quite agree with Jan Karel Pieterse... On the Windows 10 machine... when you create (manually) a new Excel workbook... how many worksheets does it have? Does it have "Sheet2" and "Sheet3"?
I also quite agree with Jan Karel Pieterse... On the Windows 10 machine... when you create (manually) a new Excel workbook... how many worksheets does it have? Does it have "Sheet2" and "Sheet3"?
ASKER
Thank you, it was that simple!