Hello and thank you for any attention my post may received.
So I have my code which takes two data sets (Incident and Action) to create a single dataset (Export). Then the single dataset is distributed to various sheets based on criteria (formula) on the Export ws. My problem is this.....when either of my unbound arrays (from Export) are empty it returns an error on the line highlighted in red font below.
I have 'On Error Resume Next' however the code still stops on this line. My code is lengthy (I have shrunk it for this post) with many sheets to distribute to and therefore I get this error multiple times throughout execution. Ideally I would like the code to skip and move to the next line of code.
Any thoughts or help will be greatly appreciated.
Have a great day!
So I have my code which takes two data sets (Incident and Action) to create a single dataset (Export). Then the single dataset is distributed to various sheets based on criteria (formula) on the Export ws. My problem is this.....when either of my unbound arrays (from Export) are empty it returns an error on the line highlighted in red font below.
I have 'On Error Resume Next' however the code still stops on this line. My code is lengthy (I have shrunk it for this post) with many sheets to distribute to and therefore I get this error multiple times throughout execution. Ideally I would like the code to skip and move to the next line of code.
Any thoughts or help will be greatly appreciated.
Have a great day!
Code:
Sub NewExport()
Dim DSsarr, DSdarr, DScolarr As Variant, DScac%, DSslr%, DSx%, DSi%, DSj%, DSk%, sI As Worksheet
lRow = Range("D" & Rows.Count).End(xlUp).row
Set CF = Sheets("AllActions").Range("D4:D" & lRow)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Export").Range("A2:K2000").Clear
Set sI = Sheets("Incident")
DScolarr = Array(1, 12, 3, 19, 17, 18, 16, 14, 15, 20, 7)
DScac = UBound(DScolarr)
DSslr = sI.Cells(Rows.Count, 22).End(xlUp).row
DSx = Application.CountIf(sI.Cells(1, 21).Resize(DSslr), "Yes")
ReDim DSdarr(DSx - 1, DScac)
DSsarr = sI.Cells(1, 1).Resize(DSslr, 22).value
DSk = 0
For DSi = 1 To DSslr
If DSsarr(DSi, 21) = "Yes" Then
For DSj = 0 To DScac
DSdarr(DSk, DSj) = DSsarr(DSi, DScolarr(DSj))
Next DSj
DSk = DSk + 1
Else
End If
Next DSi
Sheets("Export").Cells(2, 1).Resize(DSk, DScac + 1).value = DSdarr
'''' APPEND classified SHAERS data
Dim DSssarr, DSddarr, DSccolarr As Variant, DSccac%, DSsslr%, DSxx%, DSii%, DSjj%, DSkk%, sA As Worksheet
Dim nextrow As Long
Set sA = Sheets("Action")
DSccolarr = Array(1, 13, 6, 17, 19, 21, 16, 15, 23, 18)
DSccac = UBound(DSccolarr)
DSsslr = sA.Cells(Rows.Count, 23).End(xlUp).row
DSxx = Application.CountIf(sA.Cells(1, 20).Resize(DSsslr), "Yes")
nextrow = Sheets("Export").Cells(Rows.Count, "A").End(xlUp).row + 1
ReDim DSddarr(DSxx - 1, DSccac)
DSssarr = sA.Cells(1, 1).Resize(DSsslr, 23).value
DSkk = 0
For DSii = 1 To DSsslr
If DSssarr(DSii, 20) = "Yes" Then
For DSjj = 0 To DSccac
DSddarr(DSkk, DSjj) = DSssarr(DSii, DSccolarr(DSjj))
Next DSjj
DSkk = DSkk + 1
Else
End If
Next DSii
Sheets("Export").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(DSkk, DSccac + 1).value = DSddarr
Sheets("Export").Calculate
Sheets("Export").Sort.SortFields.Clear
Sheets("Export").Sort.SortFields.Add Key:=Range("G2:G5120" _
), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Mnt,Ops,R&I,Fin,Facil,H&S,HR,Site,OTHER", DataOption:=xlSortNormal
Sheets("Export").Sort.SortFields.Add Key:=Range("N2:N5120" _
), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"N,Y", DataOption:=xlSortNormal
Sheets("Export").Sort.SortFields.Add Key:=Range("D2:D5120" _
), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Priority (H),Priority,High,Medium,Low", DataOption:=xlSortNormal
With Sheets("Export").Sort
.SetRange Range("A1:V5120")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim row As Integer
row = 1
For i = 2 To row - 1
If Sheets("Export").Cells(i, 1) = "" Then
i = row
ElseIf Sheets("Export").Cells(i, 1) = Sheets("Export").Cells(i + 1, 1) Then
Rows(i + 1).Delete
i = i - 1
End If
Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''
''' SUPPORT DEPARTMENTS '''
'''''''''''''''''''''''''''''''''''''''''''''''''''
' OVERDUE - Incidents
Sheets("SupOverdue").Range("A1") = "As at " & Format(Date, "d-mmm-yy")
Sheets("SupOverdue").Range("A2:J500").ClearContents
Sheets("SupOverdue").Range("A2:J500").Font.Bold = False
Sheets("SupOverdue").Range("A2:J500").Interior.ColorIndex = xlNone
Sheets("SupOverdue").Range("A2:J500").Font.Size = 10
Sheets("SupOverdue").Range("A2:J500").ClearContents
Sheets("SupOverdue").Cells(Count + 2, 1) = "Incidents - Due and/or Overdue Now"
Sheets("SupOverdue").Cells(Count + 3, 1) = "Incident Number"
Sheets("SupOverdue").Cells(Count + 3, 2) = "Incident Date"
Sheets("SupOverdue").Cells(Count + 3, 3) = "Status"
Sheets("SupOverdue").Cells(Count + 3, 4) = "Priority"
Sheets("SupOverdue").Cells(Count + 3, 5) = "Description (limited to 110 characters)"
Sheets("SupOverdue").Cells(Count + 3, 6) = "Type"
Sheets("SupOverdue").Cells(Count + 3, 7) = "Status Owner"
Sheets("SupOverdue").Cells(Count + 3, 8) = "Status Dept."
Sheets("SupOverdue").Cells(Count + 3, 9) = "Due Date"
Sheets("SupOverdue").Cells(Count + 3, 10) = "Investigation Owner"
Sheets("SupOverdue").Cells(Count + 2, 1).Font.Bold = True
Sheets("SupOverdue").Cells(Count + 2, 1).Font.Size = 12
Sheets("SupOverdue").Range("A3:J3").Font.Bold = True
Sheets("SupOverdue").Range("A3:J3").Interior.ColorIndex = 15
Sheets("SupOverdue").Range("F:F").HorizontalAlignment = xlCenter
Dim sar, ssar, Sssar, dar, colar As Variant, cac%, slr%, x%, j%, k%, s As Worksheet
Dim Acolar As Variant, Acac%
Set s = Sheets("Export")
[B]colar = Array(1, 2, 3, 4, 5, 9, 6, 7, 8, 11)[/B]
[B]Acolar = Array(1, 2, 3, 4, 5, 9, 6, 7, 8)[/B]
cac = UBound(colar)
Acac = UBound(Acolar)
slr = s.Cells(Rows.Count, 14).End(xlUp).row
x = Application.CountIf(s.Cells(1, 17).Resize(slr), "Yes")
ReDim dar(x - 1, cac)
sar = s.Cells(1, 1).Resize(slr, 17).value
ssar = s.Cells(1, 1).Resize(slr, 7).value
Sssar = s.Cells(1, 1).Resize(slr, 14).value
k = 0
For i = 1 To slr
If sar(i, 17) = "Yes" And Sssar(i, 14) = "Y" Then
For j = 0 To cac
dar(k, j) = sar(i, colar(j))
Next j
k = k + 1
Else
End If
Next i
[COLOR=#FF0000]Sheets("SupOverdue").Cells(4, 1).Resize(k, cac + 1).value = dar[/COLOR]
' OVERDUE - Actions
Sheets("SupOverdue").Cells(Rows.Count, "A").End(xlUp).Offset(3, 0) = "Actions - Due and/or Overdue Now"
Sheets("SupOverdue").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = "Action Number"
Sheets("SupOverdue").Cells(Rows.Count, "B").End(xlUp).Offset(4, 0) = "Action Date"
Sheets("SupOverdue").Cells(Rows.Count, "C").End(xlUp).Offset(4, 0) = "Status"
Sheets("SupOverdue").Cells(Rows.Count, "D").End(xlUp).Offset(4, 0) = "Priority"
Sheets("SupOverdue").Cells(Rows.Count, "E").End(xlUp).Offset(4, 0) = "Description (limited to 110 characters)"
Sheets("SupOverdue").Cells(Rows.Count, "F").End(xlUp).Offset(4, 0) = "Extensions"
Sheets("SupOverdue").Cells(Rows.Count, "G").End(xlUp).Offset(4, 0) = "Status Owner"
Sheets("SupOverdue").Cells(Rows.Count, "H").End(xlUp).Offset(4, 0) = "Status Dept."
Sheets("SupOverdue").Cells(Rows.Count, "I").End(xlUp).Offset(4, 0) = "Due Date"
lRow = Sheets("SupOverdue").Range("A" & Rows.Count).End(xlUp).row
Set Fmr = Sheets("SupOverdue").Range("A3:A" & lRow)
For Each cell In Fmr
If cell.value = "Actions - Due and/or Overdue Now" Then
cell.Font.Bold = True
cell.Font.Size = 12
cell.Resize(, 9).Offset(1, 0).Interior.ColorIndex = 15
cell.Resize(, 9).Offset(1, 0).Font.Bold = True
End If
Next
Dim Asar, Fdar, Aslr%, Fj%, Fk%, Ax%
Aslr = s.Cells(Rows.Count, 20).End(xlUp).row
Ax = Application.CountIf(s.Cells(1, 20).Resize(Aslr), "Yes")
ReDim Fdar(Ax - 1, Acac)
Asar = s.Cells(1, 1).Resize(Aslr, 20).value
Fk = 0
For i = 1 To Aslr
If Asar(i, 20) = "Yes" And Sssar(i, 14) = "Y" Then
For Fj = 0 To Acac
Fdar(Fk, Fj) = Asar(i, Acolar(Fj))
Next Fj
Fk = Fk + 1
Else
End If
Next i
[COLOR=#FF0000]Sheets("SupOverdue").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(Fk, cac + 1).value = Fdar[/COLOR]
Call Module1.Overdue_Export
End Sub