Run Time Error: 1004

[YellowLabPro]

Application-defined or object-defined error.

This sub was part of the original routine from my last post that I am separating, I am now receiving this error. Any hints what is wrong?




Sub ImportAttribs()
Application.ScreenUpdating = False
Dim wbSource As Workbook, wbTarget As Workbook
Dim wsnSource As Worksheet, wsTarget As Worksheet
Dim tgtA As Range, cel As Range, c As Range, rng As Range, t As Range
Dim lrwSource As Long, lrwTarget As Long, iStatus As Long
Dim wbns As String, wbnt As String, wsnt As String, wPath As String

' Check to see if proper workbooks are open
If (IsWorkbookOpen("Complete_Upload_File_Green.xls")) = False Then
MsgBox "Workbook not open.", vbCritical, "Error"
Exit Sub
End If

wbns = "TGSProductsAttribPrep.xls"
wbnt = "Complete_Upload_File_Green.xls"
wsnt = "EC Products"
Set wbTarget = Workbooks(wbnt)
Set wsTarget = Workbooks(wbnt).Worksheets(wsnt)
Set tgtA = wsTarget.Columns(1)
wPath = "C:\Documents and Settings\Doug\Desktop\TGS\"

err.Clear
On Error Resume Next
Set wbSource = Workbooks(wbns)
iStatus = err
On Error GoTo 0
If iStatus Then
Workbooks.Open wPath & wbns
Workbooks(wbnt).Worksheets(wsnt).Activate
Else
Workbooks(wbnt).Worksheets(wsnt).Activate
End If

With Range("U3:W3")
.Value = Array("Price-Range", "Size-Range", "Attributes Imported")
.Font.Name = "Arial"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = 16
.HorizontalAlignment = xlCenter
End With
Columns("U:W").AutoFit


' Original code to combine attributes in the Upload worksheet and the new ones porting and joining together.
' For Each sh In wbSource.Worksheets
' With sh
' LRw = LR(sh, "A")
' Set rng = Range("A2:A" & LRw)
' For Each c In rng
' c.Value = Application.WorksheetFunction.Trim(c.Value)
' Next c
'
' For Each cel In Range(.Cells(2, 1), .Cells(LRw, 1))
' If cel.Row > 1 Then
' Set c = tgtA.Find(cel)
' If IsEmpty(c.Offset(, 8).Value) Then
' c.Offset(, 8) = cel.Offset(, 9)
' Else
' c.Offset(, 8) = c.Offset(, 8) & ";" & cel.Offset(, 9)
' End If
'
' If c Is Nothing Then
' ' MsgBox cel
' cel.Interior.ColorIndex = 3
' End If
' End If
' Next cel
' End With
' Next sh
'Newer code 9/11/07 to port new attributes to temporary column in Upload worksheet and join in additional step.
' //////////////////// Bob ////////////////////////////////

For Each wsnSource In wbSource.Worksheets
If Not wsnSource.Name = "AttribTable" Then
'''Debug.Print "WorkSheet " & wsnSource.Name
With wsnSource
lrwSource = lr(wsnSource, "A")
Set rng = .Range("A2:A" & lrwSource)
rng.Interior.ColorIndex = 0
For Each c In rng
'''Debug.Print "Worksheet " & wsnSource.Name, "Item# " & c, "Cell " & c.Address(0, 0), "Row " & c.Row
c.Value = Application.WorksheetFunction.Trim(c.Value)
Next c
For Each cel In .Range(.Cells(2, 1), .Cells(lrwSource, 1))
If cel.Row > 1 Then
Set c = tgtA.Find(cel)
'''Debug.Print "Worksheet " & wsnSource.Name, "Item# " & cel.Value, "Cell " & _
cel.Address(0, 0), "Row " & cel.Row
If c Is Nothing Then
cel.Interior.Color = vbRed
Else
>>>> c.Offset(, 22) = cel.Offset(, 9) <<<<
End If
End If
Next cel
End With
Else
Exit For
End If
Next wsnSource

Columns("U:W").AutoFit
End Sub

[fb7894]

Debug the error. Before the line of code that bombs out put...

Debug.Print c.Offset(, 22)
Debug.Print cel.Offset(, 9)


My guess is that c or cel is not set.

[mdmackillop]

Hi Doug,
Looks like you forgot to comment out the line after the continuation here


'''Debug.Print "Worksheet " & wsnSource.Name, "Item# " & cel.Value, "Cell " & _
cel.Address(0, 0), "Row " & cel.Row