Runtime Error 1004

Question

I have a workbook with VBA and I am getting a 'Run-time Error 1004' and when I hit the debug the process stops at below lines of codes:
' Insert blank rows, one to hold each period and one for the total line
    With resultArea.Cells(RowNum, KeyFigCol - 1)  {it says Application defined or Object defined error}
    If .Value <> "" Then
I saw other threads for this error and I checked the OSS-429183. Also my macro>>security is set to low.
Any suggestions? Plus I am getting this error only in dev environment, stage & production work fine. I have verified the VBA code and they all have same code.

Answer 1

Hi All, I still have this problem. I have the same VBA code in all the systems, but it gets error in development system only. its working fine in other systems. That's what breaks my head:(
Any suggestions. I have attached my VBA code.
'* Variable Declarations
  Dim Column As Integer
  Dim StrPos As Long
  Dim TempStr As String
  Dim RowNum As Integer
  Dim StrRowNum As Integer
  Dim EndRowNum As Integer
  Dim EndColNum As Integer
  Dim KeyFigCol As Integer
  Dim DelStrCol As Integer
  Dim LabelPos As Integer
  Dim ActiveCellSave As String
  Dim MonthFlag As String
  Dim MonthFlagPrev As String
  Dim MonthColStr As Integer
  Dim MonthColEnd As Integer
  Dim MonthCol1st As Integer
  Dim MatMonRow As Integer
  Dim ColPrjAvl As Integer
  Dim ColTopGrn As Integer
  Dim ColTopYel As Integer
  Dim ColTopRed As Integer
  Dim ColRmdRpl As Integer                   '001A
  Dim ColMaxQty As Integer
  Dim ColRplQty As Integer
  Dim First As Boolean
  Dim NumPeriods As Integer                  '001A
  Dim UsgPerDay As Integer                   '001A
  Dim StartTime
  Dim EndTime
' Check the query id to determine which sheet to activate
If queryID = "SAPBEXq0016" Then      'Monthly Query
  'Application.ScreenUpdating = False
'Set sheet "Inventory Montly Analysis" to active
  Sheets(3).Activate
  NumPeriods = 13                              '001A
'* 001A: Set "Inventory Weekly Analysis" to active
ElseIf queryID = "SAPBEXq0018" Then  ' Weekly query
  Sheets(4).Activate
  NumPeriods = 24
'* 001A: Set "Inventory Replenishment" to active
ElseIf queryID = "SAPBEXq0017" Then  ' Replenishment Detail query
  Sheets(6).Activate
  NumPeriods = 0
Else
  Exit Sub
End If
'* 001A: End of new code
'* Initialization Routines
  First = True
' For performance testing, save off the start time of the macro
  StartTime = Time
' Save off the current cell location so that we can restore that location
' when formatting is compelte
  ActiveCellSave = ActiveCell.Address()
  If ActiveCell.Value <> "No applicable data found." Then
' Determine the First Row in the spreadsheet where query results are displayed
' The first row will be stored in variable RowNum
  TempStr = resultArea.Address(RowAbsolute:=False, ColumnAbsolute:=False)
  StrRowNum = 0
  Do While StrRowNum = 0
    StrRowNum = Val(TempStr)
    If StrRowNum = 0 Then
      TempStr = Mid(TempStr, 2, 20)
    End If
    If TempStr = "" Then
      Exit Do
    End If
  Loop
' Determine the Last Row in the spreadsheet where query results are displayed
' The last row will be stored in variable EndRowNum
  TempStr = resultArea.Address(RowAbsolute:=False, ColumnAbsolute:=False)
  StrPos = InStr(TempStr, ":")
  TempStr = Right(TempStr, Len(TempStr) - StrPos)
  EndRowNum = 0
  Do While EndRowNum = 0
    EndRowNum = Val(TempStr)
    If EndRowNum = 0 Then
      TempStr = Mid(TempStr, 2, 20)
    End If
    If TempStr = "" Then
      Exit Do
    End If
  Loop
' Determine the Last Column in the spreadsheet where query results are displayed
' The last column number will be stored in EndColNum
  TempStr = resultArea.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlR1C1)
  StrPos = InStr(TempStr, ":")
  If StrPos > 0 Then
    TempStr = Right(TempStr, Len(TempStr) - StrPos)
    StrPos = InStr(TempStr, "C")
    If StrPos = 0 Then
      EndColNum = 255
    Else
      TempStr = Right(TempStr, Len(TempStr) - StrPos - 1)
      EndColNum = Val(TempStr)
    End If
  End If
' Clear all of the old contents below the query result area
  TempStr = Format(EndRowNum + 1) + ":" + Format(65536)
  ActiveSheet.Rows(TempStr).Select
  Selection.Clear
' Determine the location of various key figure columns needed in subsequent processing
  KeyFigCol = 0
  For Column = 1 To EndColNum
' Find the start column for the key figures - Indicated by the first column
' with a dash "-" character in it.
    If InStr(resultArea.Cells(1, Column).Value, " - ") <> 0 Then
      If KeyFigCol = 0 Then KeyFigCol = Column
    End If
' Find the Projected Available Column
    If (ColPrjAvl = 0) And (InStr(resultArea.Cells(1, Column).Value, "Proj") <> 0) Then
      ColPrjAvl = Column
    End If
' Find the Top of Green Column
    If (ColTopGrn = 0) And (InStr(resultArea.Cells(1, Column).Value, "Top of Green") <> 0) Then
      ColTopGrn = Column
    End If
' Find the Top of Yellow Column
    If (ColTopYel = 0) And (InStr(resultArea.Cells(1, Column).Value, "Top of Yellow") <> 0) Then
      ColTopYel = Column
    End If
' Find the Top of Red Column
    If (ColTopRed = 0) And (InStr(resultArea.Cells(1, Column).Value, "Top of Red") <> 0) Then
      ColTopRed = Column
    End If
' Find the Recommended Replenishment Quantity
    If (ColRmdRpl = 0) And (InStr(resultArea.Cells(1, Column).Value, "Recommended Replenishment Qty") <> 0) Then
      ColRmdRpl = Column
    End If
' Find the Usage Per Day
    If (UsgPerDay = 0) And (InStr(resultArea.Cells(1, Column).Value, "Usage Per") <> 0) Then
      UsgPerDay = Column
    End If
' Find the Maximum Order Column
    If (ColMaxQty = 0) And (InStr(resultArea.Cells(1, Column).Value, "Maximum Order Quantity") <> 0) Then
      ColMaxQty = Column
    End If
' Find the Recommended Replenishment Column
    If (ColRplQty = 0) And (InStr(resultArea.Cells(1, Column).Value, "Recommended Replenishment") <> 0) Then
      ColRplQty = Column
    End If
  Next Column
'* Begin of main formatting loop
'* Logic for Recommended Repl Highlighting
  If NumPeriods = 0 Then
' Highlight the Recommended Replenishment Quantity
    For RowNum = 2 To EndRowNum
      If resultArea.Cells(RowNum, ColRplQty).Value > resultArea.Cells(RowNum, ColMaxQty).Value Then
           resultArea.Cells(RowNum, ColRplQty).Interior.ColorIndex = 7  'Highlight Red
      End If
    Next RowNum
'* Logic for Monthly and Weekly Queries
  Else
' Work from the bottom up, inserting new lines and folding the keyfigures
' downward into one row for each month
  For RowNum = EndRowNum To 2 Step -1
' Insert blank rows, one to hold each period and one for the total line
    With resultArea.Cells(RowNum, KeyFigCol - 1)  This is where it stops & gives Runtime Error 1004
    If .Value <> "" Then
' For the bottom-most characteristic row, we must cut and paste differently to ensure
' the cells formats are properly pasted in the new rows
    If First Then
      TempStr = Format(RowNum) + ":" + Format(RowNum + NumPeriods)
      resultArea.Rows(TempStr).Select
      Selection.Insert Shift:=xlDown
      resultArea.Rows(RowNum + NumPeriods + 1).Select
      Selection.Cut
      resultArea.Rows(RowNum).Select
      ActiveSheet.Paste
      First = False
' If this is the first characteristic record, and it resides in row 2, then we know that the
' query only has one row of data - special formatting is required in this situation
      If RowNum = 2 Then
        resultArea.Cells(2, 1).Select
        Selection.Copy
        Range(ActiveSheet.Cells(StrRowNum + 2, 1), ActiveSheet.Cells(EndRowNum + NumPeriods, KeyFigCol - 1)).Select
        Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                               False, Transpose:=False
      End If
' Not the first row, use normal processing
    Else
      TempStr = Format(RowNum + 1) + ":" + Format(RowNum + NumPeriods)
      resultArea.Rows(TempStr).Select
      Selection.Insert Shift:=xlDown
    End If
' As we insert rows for each characteristic row, we need to adjust the end row
' number accordingly
    EndRowNum = EndRowNum + NumPeriods
' Initialize variables used for each set of month processing
    MatMonRow = RowNum + 1
    MonthFlagPrev = ""
    MonthFlag = ""
    MonthColStr = 0
' Scan key figure column headings from left to right, looking for changes in month
    For i = KeyFigCol To EndColNum + 1
' Get the month text for each column
      MonthFlag = ""
      TempStr = resultArea.Cells(1, i).Value
      MonthFlag = Mid(TempStr, InStr(TempStr, "-") + 1, 15)
' If we move into a new month, then copy and paste the previous month downward
      If ((MonthFlag <> MonthFlagPrev) And (MonthFlagPrev <> "")) Or (i = EndColNum + 1) Then
        If DelStrCol = 0 Then DelStrCol = i + 1     ' Capture last key figure of first month
        If i = EndColNum + 1 Then i = i + 1         'For results row, need to extend by one
' Copy and paste values for previous month
        Range(resultArea.Cells(RowNum, MonthColStr), resultArea.Cells(RowNum, i - 1)).Select
        Selection.Copy
        resultArea.Cells(MatMonRow, MonthCol1st).Select
        ActiveSheet.Paste
' Paste the Month text into the row heading
        resultArea.Cells(MatMonRow, MonthCol1st - 1).Value = MonthFlagPrev
        If MonthFlagPrev = " Average Result" Then
          Range(resultArea.Cells(MatMonRow, MonthCol1st - 1), resultArea.Cells(MatMonRow, EndColNum)).Select
          Selection.Interior.ColorIndex = 36
        End If
        With resultArea.Cells(MatMonRow, ColPrjAvl)
        If .Value >= resultArea.Cells(RowNum, ColTopGrn).Value Then
           .Interior.ColorIndex = 43   'Green Green
        ElseIf .Value >= resultArea.Cells(RowNum, ColTopYel).Value Then
           .Interior.ColorIndex = 14   'Green
        ElseIf .Value >= resultArea.Cells(RowNum, ColTopRed).Value Then
           .Interior.ColorIndex = 44   'Yellow
         Else
           .Interior.ColorIndex = 7  'Red
        End If
        End With
        MonthColStr = i
        MatMonRow = MatMonRow + 1
      End If
' Set variables on first pass through
      If MonthColStr = 0 Then
        MonthColStr = i
        MonthCol1st = i
        MonthFlagPrev = MonthFlag
      End If
' Capture the previous month text
      If MonthFlagPrev <> "" Then
        MonthFlagPrev = MonthFlag
      End If
    Next i
' Clear out the key figure data at the lowest characteristic level
    Range(resultArea.Cells(RowNum, KeyFigCol), resultArea.Cells(RowNum, EndColNum)).Select
    Selection.ClearContents
    End If
    End With
    Next RowNum
' Strip out the month text from column headings
    For i = KeyFigCol To DelStrCol
    LabelPos = InStr(resultArea.Cells(1, i).Value, "-")
      If LabelPos > 1 Then resultArea.Cells(1, i).Value = _
                           Left(resultArea.Cells(1, i).Value, LabelPos - 1)
    Next i
' Remove Extraneous columns (months 2-12)
    Range(resultArea.Cells(1, DelStrCol - 1), resultArea.Cells(EndRowNum, EndColNum + 1)).Select
    Selection.Clear
' Format Column Headings with appropriate column widths and heights
    resultArea.Rows(1).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .MergeCells = False
        .RowHeight = 31.5
    End With
' 001A: Add empty cells for Recommended replenishment
        If ColRmdRpl <> 0 Then
          For i = 2 To EndRowNum
            If resultArea.Cells(i - 1, 1) = "" Then
              Range(resultArea.Cells(i, ColRmdRpl), resultArea.Cells(i, ColRmdRpl + 4)).Insert Shift:=xlToRight
            End If
          Next i
          Columns(ColRmdRpl + 5).Copy
          Range(Columns(ColRmdRpl), Columns(ColRmdRpl + 4)).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
          Application.CutCopyMode = False                     
        If UsgPerDay <> 0 Then
          For i = 2 To EndRowNum
            If resultArea.Cells(i - 1, 1) = "" Then
               resultArea.Cells(i, UsgPerDay).Insert Shift:=xlToRight
            End If
          Next i
          Columns(ColRmdRpl + 5).Copy
          Range(Columns(ColRmdRpl), Columns(ColRmdRpl + 4)).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
          Application.CutCopyMode = False
        End If
        For i = 3 To EndRowNum
          If resultArea.Cells(i - 1, 1) <> "" Then
             Range(resultArea.Cells(i, ColRmdRpl + 1), resultArea.Cells(i + NumPeriods - 1, ColRmdRpl + 4)).Select
             Selection.FillDown
             Range(resultArea.Cells(i, UsgPerDay), resultArea.Cells(i + NumPeriods - 1, UsgPerDay)).Select
             Selection.FillDown
          End If
        Next i
' Remove Extraneous columns (months 2-12)
          Range(resultArea.Cells(1, DelStrCol - 1), resultArea.Cells(EndRowNum, EndColNum + 1)).Select
          Selection.Clear
        End If
' 001A: End of new code
    End If
    End If
    Columns("A:BA").ColumnWidth = 10
    resultArea.Columns.AutoFit
' Set Zoom level at 75%
    ActiveWindow.Zoom = 75
' Restore the active cell
    Range(ActiveCellSave).Select
  '  EndTime = Time
  '  MsgBox StartTime
  '  MsgBox EndTime
'   StartTime = EndTime - StartTime
'   MsgBox StartTime
'   End If
'  End If 
'Application.ScreenUpdating = True 
End Sub