Empty UBound Array Returns Error

N

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

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
Nadine

Where do you get the error?
 
Upvote 0
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
Click to expand...
If the array has data it will execute, if not it moves to the next line of code.
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Kenneth Hobson said:
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.
Click to expand...

Looks like wrong thread Ken.
 
Upvote 0
Hi Kenneth and thank you for your suggestion however in this instance there will never be a long value.

Cheers!
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Copy and paste data through multiple workbooks
Replies
2
Views
184
CDaviess
C
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
356
sspatriots
S
A
  • Solved
WeekNum function not returning correct value
Replies
2
Views
115
AndyEd
A
C
  • Question
A Bookmark to return to the same row when exiting and opening the application
Replies
8
Views
154
Edgar_
Edgar_
S
  • Solved
Paste the data in row 10
Replies
2
Views
228
sofas
S

Forum statistics

Threads
1,214,649
Messages
6,120,732
Members
448,987
Latest member
marion_davis

Share this page

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