Empty UBound Array Returns Error

Nadine67

Board Regular
Joined
May 27, 2015
Messages
225
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!

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
 
JLGWhiz thank you for your suggestion but I still get error 1004 from this

Code:
If UBound(colar) <> 0 Then
Sheets("SupOverdue").Cells(4, 1).Resize(k, cac + 1).value = dar
End If
Error 1004 is usually related to User Interface errors like syntax, typos or some other error not predetermined and trapped by system software. Check all your spelling and variable references to make sure they are correct and are returning the correct values. Off-hand, I see nothing that would cause the error.
you could also try this in case your array is 1 based.
Code:
If UBound(colar) <> LBound(colar) Then
 Sheets("SupOverdue").Cells(4, 1).Resize(k, cac + 1).value = dar
 End If
 
Last edited:
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
*** SOLVED ***

Ok so I have used Kenneth's suggestion with a tweak. I have combined the suggestion with an existing calculated value on Export and it works brilliantly.

Thank you so very much Kenneth, and also thank you Norie and JLGWhiz for your attention.

This is the solution...
Code:
If s.Cells(3, 28) <> 0 Then
Sheets("SupOverdue").Cells(4, 1).Resize(k, cac + 1).value = dar
End If

Thank you all once again!

*** SOLVED ***
 
Upvote 0
Np. Sometimes, it's the simply things that trip us up.

Playing with the array routine, I did this. I also show how integer gives an error but not long for what that's worth. Of course VBE's Immediate window shows the results of a run's Debug.Print. I use it and Msgbox() to debug sometimes.
Code:
Sub Test()
  Dim a, r&, c&, x%, y&
  MsgBox isArrayEmpty(a)
  a = [{1,2,3;11,22,33}]
  Debug.Print UBound(a, 1), UBound(a, 2)
  For r = 1 To UBound(a, 1)
    For c = 1 To UBound(a, 2)
      Debug.Print a(r, c)
    Next c
  Next r
  MsgBox isArrayEmpty(a)
  
  x = 32767  '32768=error 6, overflow error
  y = 32768
End Sub
 
Upvote 0
Oh ok that's great. I actually have another workbook which I am developing and will incorporate your suggestion into. Thank you very much Kenneth for your time and help. Much appreciated.

Have a great day!
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,974
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top