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
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,278
Office Version
  1. 365
Platform
  1. Windows
Nadine

Where do you get the error?
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
You can use If...Then statements to test if the array contains anything before trying to post it to a range.
If UBound(Array) <> 0 Then
'execute data post
End If
If the array has data it will execute, if not it moves to the next line of code.
 

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,170
Office Version
  1. 365
Platform
  1. Windows
Maybe not it but variables with row number values should always be dimmed as Long. I noticed that slr is dimmed as Integer. That will be ok providing your variable never has to store a Long value.
 

Nadine67

Board Regular
Joined
May 27, 2015
Messages
225

ADVERTISEMENT

Hi Norie

The lines of code which highlights when I debug can be these


Code:
Sheets("SupOverdue").Cells(4, 1).Resize(k, cac + 1).value = dar

OR

Code:
Sheets("SupOverdue").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(Fk, cac + 1).value = Fdar
 

Nadine67

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

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Maybe not it but variables with row number values should always be dimmed as Long. I noticed that slr is dimmed as Integer. That will be ok providing your variable never has to store a Long value.

Looks like wrong thread Ken.
 

Nadine67

Board Regular
Joined
May 27, 2015
Messages
225
Hi Kenneth and thank you for your suggestion however in this instance there will never be a long value.

Cheers!
 

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,170
Office Version
  1. 365
Platform
  1. Windows
No, right thread.

Maybe checking if array is empty would help.
Code:
'http://sitestory.dk/excel_vba/csv-file-import.htm
'**************************************************************
Public Function isArrayEmpty(parArray As Variant) As Boolean
  'Returns False if not an array or a dynamic array
  'that hasn't been initialised (ReDim) or
  'deleted (Erase).
  
  If IsArray(parArray) = False Then isArrayEmpty = True
  On Error Resume Next
  If UBound(parArray) < LBound(parArray) Then
     isArrayEmpty = True
     Exit Function
  Else
     isArrayEmpty = False
  End If
End Function
 

Nadine67

Board Regular
Joined
May 27, 2015
Messages
225
Kenneth I used your function and got the same error.

Do I need to change 'parArray' to the name of my array? Also I put this function in a Module within the workbook as this workbook will be used by other users in the business.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,384
Messages
5,635,985
Members
416,891
Latest member
Okomomo

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
Top