3

I've been getting the following error message:

Run-time error '1004':

Application-defined or object-defined error

when I attempt to write an array to a worksheet. Here's the relevant snippet of code:

'Write data from arrUniverseData into wsDetails worksheet
    lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1
    lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1
    Set rngDestination = wsDetails.Range("A" & lngFirstDetailsRow).Resize(lngNumRows, lngNumColumns)
    rngDestination = arrUniverseData

The error displays on the last line. I've triple-checked: all of these variables are defined and working properly earlier in the procedure. In fact, about 50 lines up I use this same exact code to write to a different worksheet and it works just fine.

Interestingly, it appears that this line is actually attempting to work. If I look in the wsDetails worksheet, I can see that it has written the first 6,092 rows. There are a total of ~14-15k rows in the array that need to be written (there are 106 columns).

This piece of code was working just fine when I only had 104 columns (haven't changed anything except the array size to accommodate a new data set). Is this a memory/size issue?

I'd be willing to post the entire code here if it's helpful, but it's pretty hefty. Thanks in advance for any comments or suggestions!

Edit: here is the entire procedure in case it helps. I really don't see anything wrong here:

Option Explicit
Sub CostReductionRollup()

'Display a message box verifying that the user has already saved a backup
If MsgBox("This rollup procedure will replace any existing data in all of the worksheets of this workbook--please make sure you have saved this file as a copy to prevent overwriting previous rollups.", vbOKCancel, "Warning--Save a Backup") = vbCancel Then
    Exit Sub
End If

'Update Status Bar
    Call UpdateStatusBar(0, 10, 0, "Processing Universe data...")

'Disable screen updating to reduce processing time
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

'Set public workbook, worksheet, directory, and date variables
    Set wbRollup = ActiveWorkbook
    Set wbMacro = ThisWorkbook
    Set wsProcess = wbRollup.Worksheets("Process")
    Set wsDetails = wbRollup.Worksheets("Details")
    strUniverseServerPath = wsProcess.Range("B7").Text & wsProcess.Range("B10").Text
    Set wbUniverse = Workbooks.Open(strUniverseServerPath)
    Set wsUniverse = wbUniverse.Worksheets("LOS Report")
    datRollupDate = Date

'Copy last month's subtotals into the "previous rollup" cells for easy comparison
    wsDetails.Range("N1").Value = wsDetails.Range("N2").Value
    wsDetails.Range("O1").Value = wsDetails.Range("O2").Value
    wsDetails.Range("P1").Value = wsDetails.Range("P2").Value
    wsDetails.Range("Q1").Value = wsDetails.Range("Q2").Value
    wsDetails.Range("R1").Value = wsDetails.Range("R2").Value

'Store data from Universe Report into arrUniverseData
    Dim lngFirstUniverseRow As Long
    Dim lngLastUniverseRow As Long
    lngFirstUniverseRow = 1 'Stores header row
    lngLastUniverseRow = wsUniverse.UsedRange.Rows.Count
    arrUniverseData = wsUniverse.Range("A" & lngFirstUniverseRow & ":CR" & lngLastUniverseRow)

'Close wbUniverse without saving changes
    wbUniverse.Close SaveChanges:=False

'Update Status Bar
    Call UpdateStatusBar(0, 10, 1, "Arranging Universe data...")

'Create wsTemp to temporarily store data while it is manipulated
    wbRollup.Worksheets.Add().Name = "Temp"
    Set wsTemp = wbRollup.Worksheets("Temp")

'Write data from arrUniverseData to wsTemp
    Dim lngNumRows As Long
    Dim lngNumColumns As Long
    lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1
    lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1
    Set rngDestination = wsTemp.Range("A1").Resize(lngNumRows, lngNumColumns)
    rngDestination = arrUniverseData

'Insert column in wsTemp for YE Type
    wsTemp.Range("Y1").EntireColumn.Insert
    wsTemp.Range("Y1").Value = "YE_TYPE"

'Insert column in wsTemp for At Risk
    wsTemp.Range("Z1").EntireColumn.Insert
    wsTemp.Range("Z1").Value = "AT_RISK"

'Insert column in wsTemp for DC EM
    wsTemp.Range("O1").EntireColumn.Insert
    wsTemp.Range("O1").Value = "DC_EM"

'Insert column in wsTemp for Implementation Month-Year
    wsTemp.Range("CU1").EntireColumn.Insert
    wsTemp.Range("CU1").Value = "IMPLEMENTATION_MONTH_YEAR"

'Insert column in wsTemp for Carryover Implementation Month
    wsTemp.Range("CU1").EntireColumn.Insert
    wsTemp.Range("CU1").Value = "CARRYOVER_IMPLEMENTATION_MONTH"

'Insert column in wsTemp for Carryover Months
    wsTemp.Range("CU1").EntireColumn.Insert
    wsTemp.Range("CU1").Value = "CARRYOVER_MONTHS"

'Insert column in wsTemp for Current Year Net Fiscal Impact (Factored)
    wsTemp.Range("CU1").EntireColumn.Insert
    wsTemp.Range("CU1").Value = "CURRENT_YEAR_NET_FISCAL_IMPACT_(FACTORED)"

'Insert column in wsTemp for Adjusted (Floating) Impact
    wsTemp.Range("CU1").EntireColumn.Insert
    wsTemp.Range("CU1").Value = "ADJUSTED_(FLOATING)_IMPACT"

'Insert column in wsTemp for Concatenate
    wsTemp.Range("DA1").EntireColumn.Insert
    wsTemp.Range("DA1").Value = "CONCATENATE"

'Insert column in wsTemp for YTD CICT Expected Savings
    wsTemp.Range("DB1").EntireColumn.Insert
    wsTemp.Range("DB1").Value = "YTD_CICT_EXPECTED_SAVINGS"

'Update Status Bar
    Call UpdateStatusBar(0, 10, 2, "Writing Universe data to temporary data source...")

'Store new data from wsTemp into arrUniverseData
    lngFirstUniverseRow = 1
    lngLastUniverseRow = wsTemp.UsedRange.Rows.Count
    arrUniverseData = wsTemp.Range("A" & lngFirstUniverseRow & ":DB" & lngLastUniverseRow)
    lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1
    lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1

'Update Status Bar
    Call UpdateStatusBar(0, 10, 3, "Calculating...")

'----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------MAIN LOOP----------
'Loop through arrUniverseData and determine YE Type and whether project is At Risk
    Dim i As Long 'looper variable
    Dim datImpactDate As Date 'Date to hold line item's impact date
    Dim strCICTStatus As String 'String to hold line item's CICT status
    Dim strDCEM() As String 'String array to hold design control engineering managers
    For i = 2 To lngNumRows 'do not change first row
        datImpactDate = arrUniverseData(i, 25)
        strCICTStatus = arrUniverseData(i, 24)
        'Set YE Type
            If strCICTStatus = "In Queue" Or strCICTStatus = "In Process : Pending Approval" Or strCICTStatus = "In Process : Business Case Started" Then
                arrUniverseData(i, 26) = "Potential"
            ElseIf strCICTStatus = "In Process : Execution Started" Then
                arrUniverseData(i, 26) = "Active"
            ElseIf strCICTStatus = "Complete" And Year(datRollupDate) - Year(datImpactDate) = 1 Then
                arrUniverseData(i, 26) = "Carryover"
            ElseIf strCICTStatus = "Complete" And Year(datRollupDate) = Year(datImpactDate) And datImpactDate < datRollupDate Then
                arrUniverseData(i, 26) = "In Production"
            ElseIf strCICTStatus = "Complete" And Year(datRollupDate) = Year(datImpactDate) And datImpactDate >= datRollupDate Then
                arrUniverseData(i, 26) = "Engineering Complete"
            ElseIf strCICTStatus = "Complete" And Year(datRollupDate) < Year(datImpactDate) Then
                arrUniverseData(i, 26) = "Engineering Complete"
            End If
        'Set At Risk
            If arrUniverseData(i, 26) = "Carryover" Then
                arrUniverseData(i, 27) = "n"
            ElseIf arrUniverseData(i, 26) = "Potential" Then
                If DateDiff("d", datRollupDate, datImpactDate) <= 180 Then
                    arrUniverseData(i, 27) = "y"
                Else
                    arrUniverseData(i, 27) = "n"
                End If
            ElseIf arrUniverseData(i, 26) = "Active" Then
                If DateDiff("d", datRollupDate, datImpactDate) <= 60 Then
                    arrUniverseData(i, 27) = "y"
                Else
                    arrUniverseData(i, 27) = "n"
                End If
            ElseIf arrUniverseData(i, 26) = "Engineering Complete" Then
                If DateDiff("d", datRollupDate, datImpactDate) <= 31 Then
                    arrUniverseData(i, 27) = "y"
                Else
                    arrUniverseData(i, 27) = "n"
                End If
            Else
                arrUniverseData(i, 27) = "n"
            End If
        'Set DC EM
            If arrUniverseData(i, 98) <> "" Then
                strDCEM() = Split(arrUniverseData(i, 98), "/")
                arrUniverseData(i, 15) = strDCEM(0)
            ElseIf arrUniverseData(i, 97) <> "" Then
                arrUniverseData(i, 15) = arrUniverseData(i, 97)
            ElseIf arrUniverseData(i, 95) <> "" Then
                arrUniverseData(i, 15) = arrUniverseData(i, 95)
            ElseIf arrUniverseData(i, 93) <> "" Then
                arrUniverseData(i, 15) = arrUniverseData(i, 93)
            ElseIf arrUniverseData(i, 91) <> "" Then
                arrUniverseData(i, 15) = arrUniverseData(i, 91)
            ElseIf arrUniverseData(i, 89) <> "" Then
                arrUniverseData(i, 15) = arrUniverseData(i, 89)
            End If
        'Calculate Current Year Net Fiscal Impact (Factored)
            If arrUniverseData(i, 26) = "Potential" Then
                arrUniverseData(i, 100) = 0.25 * arrUniverseData(i, 59)
            ElseIf arrUniverseData(i, 26) = "Active" Then
                arrUniverseData(i, 100) = 0.75 * arrUniverseData(i, 59)
            Else
                arrUniverseData(i, 100) = arrUniverseData(i, 59)
            End If
        'Calculate Carryover Months
            If arrUniverseData(i, 26) = "Carryover" Then
                arrUniverseData(i, 101) = arrUniverseData(i, 82) - 1
            Else
                arrUniverseData(i, 101) = 0
            End If
        'Calculate Carryover Implementation Month
            If arrUniverseData(i, 101) = 1 Then
                arrUniverseData(i, 102) = "Feb"
            ElseIf arrUniverseData(i, 101) = 2 Then
                arrUniverseData(i, 102) = "Mar"
            ElseIf arrUniverseData(i, 101) = 3 Then
                arrUniverseData(i, 102) = "Apr"
            ElseIf arrUniverseData(i, 101) = 4 Then
                arrUniverseData(i, 102) = "May"
            ElseIf arrUniverseData(i, 101) = 5 Then
                arrUniverseData(i, 102) = "Jun"
            ElseIf arrUniverseData(i, 101) = 6 Then
                arrUniverseData(i, 102) = "Jul"
            ElseIf arrUniverseData(i, 101) = 7 Then
                arrUniverseData(i, 102) = "Aug"
            ElseIf arrUniverseData(i, 101) = 8 Then
                arrUniverseData(i, 102) = "Sep"
            ElseIf arrUniverseData(i, 101) = 9 Then
                arrUniverseData(i, 102) = "Oct"
            ElseIf arrUniverseData(i, 101) = 10 Then
                arrUniverseData(i, 102) = "Nov"
            ElseIf arrUniverseData(i, 101) = 11 Then
                arrUniverseData(i, 102) = "Dec"
            End If
        'Calculate Implementation Year-Month
            arrUniverseData(i, 103) = arrUniverseData(i, 83) & "-" & arrUniverseData(i, 82)
        'Set current fiscal columns of In Queue projects to $0
            If strCICTStatus = "In Queue" Then
                arrUniverseData(i, 57) = 0
                arrUniverseData(i, 58) = 0
                arrUniverseData(i, 59) = 0
                arrUniverseData(i, 99) = 0
            End If
        'Calculate Adjusted (Floating) Impact
            arrUniverseData(i, 99) = -((arrUniverseData(i, 44) * arrUniverseData(i, 46)) / 365) * DateDiff("d", datImpactDate, "12/31/" & Year(datImpactDate))
        'Calculate Concatenate
            If Len(arrUniverseData(i, 40)) < 4 Then
                arrUniverseData(i, 105) = "LS" & arrUniverseData(i, 40) & arrUniverseData(i, 28)
            Else
                arrUniverseData(i, 105) = "" & arrUniverseData(i, 40) & arrUniverseData(i, 28)
            End If
        'Calculate YTD CICT Expected Savings
            If Year(datImpactDate) = Year(Date) And arrUniverseData(i, 26) = "In Production" Then
                arrUniverseData(i, 106) = (arrUniverseData(i, 59) / DateDiff("d", datImpactDate, "12/31/" & Year(Date))) * (DateDiff("d", datImpactDate, Date))
            Else
                arrUniverseData(i, 106) = 0
            End If
    Next i

'Update Status Bar
    Call UpdateStatusBar(0, 10, 5, "Writing calculations to temporary data source...")

'Write data from arrUniverseData to wsTemp
    lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1
    lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1
    Set rngDestination = wsTemp.Range("A1").Resize(lngNumRows, lngNumColumns)
    rngDestination = arrUniverseData

'Rearrange Columns
    Call Rearrange_wsTemp_Columns

'Insert Dummy rows (12 dummy rows for current year, 12 dummy rows for previous year)
    Call InsertDummyRows

'Store new data from wsTemp into arrUniverseData
    lngFirstUniverseRow = 2 'Do not take header row
    lngLastUniverseRow = wsTemp.UsedRange.Rows.Count
    arrUniverseData = wsTemp.Range("A" & lngFirstUniverseRow & ":DB" & lngLastUniverseRow)

'Update Status Bar
    Call UpdateStatusBar(0, 10, 6, "Writing data to Details worksheet...")

'Clear data from wsDetails
    lngFirstDetailsRow = 5 'leaves room for the wsDetails headers
    lngLastDetailsRow = wsDetails.UsedRange.Rows.Count + 5
    wsDetails.Rows(lngFirstDetailsRow & ":" & lngLastDetailsRow).ClearContents
    wsDetails.Rows(lngFirstDetailsRow & ":" & lngLastDetailsRow).Delete

'Write data from arrUniverseData into wsDetails worksheet
    lngNumRows = UBound(arrUniverseData, 1) - LBound(arrUniverseData, 1) + 1
    lngNumColumns = UBound(arrUniverseData, 2) - LBound(arrUniverseData, 2) + 1
    Set rngDestination = wsDetails.Range("A" & lngFirstDetailsRow).Resize(lngNumRows, lngNumColumns)
    rngDestination = arrUniverseData

End Sub

If I change that last line from

rngDestination = arrUniverseData

To

rngDestination = "Test"

it works just fine (spits out "Test" in all 14493 rows and 106 columns). Which means that it knows lngNumRows = 14493 and lngNumColumns = 106 so the array itself is properly defined.

I am completely at a loss here.

Tom Winchester
  • 387
  • 2
  • 7
  • 22
  • 2
    My guess is that the number of rows exceeds the remaining rows on your worksheet, which can cause that exact error. Can you double check and make sure you have enough open rows left on the worksheet to write the array data to? – tigeravatar Jan 21 '16 at 17:48
  • That's a good suggestion--above the code that I posted, the procedure clears the contents from rows 3 through the last used row. Afterwards, this little snippet starts writing in row 3 (lngFirstDetailsRow = 3). So when I debug after this error pops up, I can see that it wrote from row 3 to row 6,092 but then suddenly stops. What's even more odd is that if I hover over the lngNumRows and lngNumColumns it shows ~14.5k and 106, respectively. – Tom Winchester Jan 21 '16 at 18:26
  • hmm.. I made a test array that was 15000 x 106 and it populated the array and ouput the data to the worksheet successfully. The snippet of code you posted shouldn't cause any problems if your starting cell is A3. With just the information here, I can't find a problem that would cause the error. – tigeravatar Jan 21 '16 at 18:52
  • If it was a data/memory issue then the debug would have prompted on the statement where you load the array. Can you please provide the debug message? – Enamul Hassan Jan 21 '16 at 19:08
  • Good suggestion @manetsus--I've added the error message to my original question. – Tom Winchester Jan 21 '16 at 19:13
  • @tigeravatar--agreed. I don't see anything wrong with this code either. I have this exact code (to the letter) about 30 lines earlier in the procedure as well...and it runs just fine there. – Tom Winchester Jan 21 '16 at 19:16
  • 1
    It is possibly the length of one or more elements of the array you are looking to write to the sheet. In my answer her, http://stackoverflow.com/questions/13663370/dumping-variant-array-to-range-vba-excel-error-1004, the error you mentions occurs in earlier versions of excel when looking to write more than 911 characters. – brettdj Jan 22 '16 at 02:01
  • Hmm--this is potentially the case @brettdj. One of the columns I added to the array is a concatenate between two part numbers. They SHOULD both be 8 digits long for a max of 16 characters, but I've seen some of my coworkers do crazy things. I'll verify tomorrow and report back. Thanks for the suggestion! – Tom Winchester Jan 22 '16 at 03:47
  • @brettdj--Unfortunately, that wasn't the problem (the longest string I had in the array was 24 characters). However, I DID notice that one of the new columns I added (which was financial data) was being formatted as a date when it was written to the temporary worksheet. This creates a problem anytime there was a negative number being formatted as a date. Formatting that column as "General" solved my error. – Tom Winchester Jan 22 '16 at 16:41

1 Answers1

0

So without looking at the data set, there is no way for you guys to have known this, but it turns out that one of the new columns I added was formatted as a "Date" when it was written to the wsTemp worksheet. However, the data contained in this cell was financial information.

So I added the following to the code:

wsTemp.Columns("DB:DB").NumberFormat = "General"

Just before the procedure writes all of the data to the array. Now everything works just fine. I'm guessing it had something to do with negative values (for financial losses) conflicting with the date format.

Hopefully this may help someone else in the future that experiences a similar error. Thanks everyone for your input--it was greatly appreciated!

Tom Winchester
  • 387
  • 2
  • 7
  • 22