got error 1004 when executing this code

[robnet77]

Hi everyone, I haven't programmed in VBA for ages, was reviewing to no avail some code I'm not the user of, that raises an error message 1004 (don't have the details handy at the moment) at the following line:

If levelcell <= 15 Then levelcell.InsertIndent levelcell

don't see a levelcell object having being created anywhere, don't know whether there's a built-in function with a similar name in Excel to create indentations?



[vba]


Sub IndentBAAM()
Dim LastCell As Variant
Dim intLoop As Integer, intRow As Integer, intPosition As Integer
Dim intX As Integer, intY As Integer
Dim strRange As String, strPart As String
Dim BMCPFileName As String
Dim GroupRange As Variant


'Constants give headers Names
Const conLevel As Integer = 1
Const conPrefix As Integer = 2
Const conDrwg As Integer = 3
Const conSuffix As Integer = 4
Const conQty As Integer = 5
Const conQtyCum As Integer = 6
Const conUM As Integer = 7
Const conDesc As Integer = 8
Const conItype As Integer = 9
Const conHorz As Integer = 10
Const conMRP As Integer = 11
Const conStartDate As Integer = 12
Const conStopDate As Integer = 13
Const conRev As Integer = 14
Const conLeadTm As Integer = 15
Const conLeadTimeCum As Integer = 16
Const conMRPOrder As Integer = 17
Const conSeqNo As Integer = 18
Const conWhat As Integer = 19
Const conMRPOH As Integer = 20
Const conLbr As Integer = 21
Const conMatl As Integer = 22
Const conSetup As Integer = 23
Const conExtrn As Integer = 24
Const conMicsMatl As Integer = 25
Const conBlank As Integer = 26


BMCPFileName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If BMCPFileName = "False" Then
MsgBox "Application Cancelled... ", vbOKOnly, "Cancel"
Exit Sub
End If

Application.ScreenUpdating = False
Workbooks.OpenText Filename:=BMCPFileName, Origin:= _
xlWindows, StartRow:=6, DataType:=xlDelimited, _
Tab:=False, Semicolon:=False, Comma:=False, Other:=True, OtherChar:="~", FieldInfo:= _
Array(Array(conLevel, 1), Array(conPrefix, 2), Array(conDrwg, 2), Array(conSuffix, 9), _
Array(conQty, 1), Array(conQtyCum, 9), Array(conUM, 2), Array(conDesc, 2), _
Array(conItype, 2), Array(conHorz, 2), Array(conMRP, 2), Array(conStartDate, 9), _
Array(conStopDate, 9), Array(conRev, 2), Array(conLeadTm, 1), Array(conLeadTimeCum, 1), _
Array(conMRPOrder, 9), Array(conSeqNo, 9), Array(conWhat, 9), Array(conMRPOH, 9), _
Array(conLbr, 9), Array(conMatl, 9), Array(conSetup, 9), Array(conExtrn, 9), _
Array(conMicsMatl, 9), Array(conBlank, 9))

'Perform initial Formatting

'************************************************************************** ***********'
Range("A:L").Font.Size = 14


Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1") = "Level"
Range("B1") = "Pin"
Range("C1") = "Drawing#"
Range("D1") = "Qty"
Range("E1") = "UM"
Range("F1") = "Description"
Range("G1") = "T"
Range("H1") = "H"
Range("I1") = "Planner"
Range("J1") = "Revision"
Range("K1") = "LeadTime"
Range("L1") = "CumLeadTime"

Cells.EntireColumn.AutoFit
Range("A1:L1").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With

Columns("F:F").Select
Selection.Cut
Columns("D").Select
Selection.Insert Shift:=xlToRight

Columns("B:B").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Columns("E:L").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With


' Indent Each Level
'No indent level zero, so use this for the parent
Range("A2").HorizontalAlignment = xlLeft
'Indent the rest of the rows by their value
For Each levelcell In ActiveSheet.Range("A3:A" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row)
If levelcell <= 15 Then levelcell.InsertIndent levelcell
Next levelcell

' Fit everything to one window
ActiveWindow.View = xlPageBreakPreview
Cells.Select
Cells.EntireColumn.AutoFit
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
Range("A1").Select

' Repeat header on each sheet
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
End With

'Trim the fields to eliminate any extra spaces
For intLoop = 1 To 3
If intLoop = 1 Then strRange = "C1:C" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row
If intLoop = 2 Then strRange = "D1" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row
If intLoop = 3 Then strRange = "I1:I" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row
For Each TextCell In ActiveSheet.Range(strRange)
TextCell.Value = Trim(TextCell)
Next TextCell
Next intLoop

'Name Sheet the Top Level Drawing
strPart = Cells(2, 3)

'Make sure sheet name doesn't contain illegal Characters (Rev 3)
KillColon:
intPosition = InStr(strPart, ":")
If intPosition > 0 Then
strPart = Left(strPart, intPosition - 1) & Right(strPart, Len(strPart) - intPosition)
GoTo KillColon
End If

KillFSlash:
intPosition = InStr(strPart, "\")
If intPosition > 0 Then
strPart = Left(strPart, intPosition - 1) & Right(strPart, Len(strPart) - intPosition)
GoTo KillFSlash
End If

KillBSlash:
intPosition = InStr(strPart, "/")
If intPosition > 0 Then
strPart = Left(strPart, intPosition - 1) & Right(strPart, Len(strPart) - intPosition)
GoTo KillBSlash
End If

KillQuestMark:
intPosition = InStr(strPart, "?")
If intPosition > 0 Then
strPart = Left(strPart, intPosition - 1) & Right(strPart, Len(strPart) - intPosition)
GoTo KillQuestMark
End If

KillAst:
intPosition = InStr(strPart, "*")
If intPosition > 0 Then
strPart = Left(strPart, intPosition - 1) & Right(strPart, Len(strPart) - intPosition)
GoTo KillAst
End If

KillLBracket:
intPosition = InStr(strPart, "[")
If intPosition > 0 Then
strPart = Left(strPart, intPosition - 1) & Right(strPart, Len(strPart) - intPosition)
GoTo KillLBracket
End If

KillRBracket:
intPosition = InStr(strPart, "]")
If intPosition > 0 Then
strPart = Left(strPart, intPosition - 1) & Right(strPart, Len(strPart) - intPosition)
GoTo KillRBracket
End If

' Rename Sheet to Part Name
ActiveSheet.Name = strPart


' Add in document DART Prints
' Add a new sheet called Dart and copy of Drawing Numbers
Sheets.Add After:=Worksheets(Worksheets.Count)
Sheets("Sheet1").Name = "DART"
Sheets(strPart).Select
Columns("C:C").Copy
Sheets("DART").Select
Columns("A:A").Select
ActiveSheet.Paste

'for each cell get the drawing number
'if like "***L*" the kit so skip, If N* then bolt so truncate, else Left(8)
For intX = 2 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
If Cells(intX, 1) Like "***L*" Then
Cells(intX, 1) = ""
ElseIf Cells(intX, 1) Like "N*" Then
For intY = Len(Cells(intX, 1)) To 1 Step -1
If Mid(Cells(intX, 1), intY, 1) = "P" Then
Cells(intX, 1) = Left(Cells(intX, 1), intY - 1)
Exit For
End If
Next intY
Else
Cells(intX, 1) = Left(Cells(intX, 1), 8)
End If
Next intX

'Now sort out only distinct prints and delete the rest
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns("B:B"), Unique:=True
Columns("A:A").Delete
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Header:=xlYes, Orientation:=xlTopToBottom
Columns("A:A").EntireColumn.AutoFit

If Cells(2, 1) = "" Then Cells(2, 1).Delete

Range("A1").Select

'Flip back to the BAAM
Sheets(strPart).Select

'************************************************************************** ***********'

'Determine Highest Outline Level
myHighLevel = 0
For Each levelcell In ActiveSheet.Range("A2:A" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row)
If levelcell > myHighLevel Then
myHighLevel = levelcell
End If
Next levelcell

'Set counters
counter = 0
myStartSize = 14
myStartColor = 3

'Change Font Styles
Do While counter <= myHighLevel
For Each levelcell In ActiveSheet.Range("A2:A" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row)
If levelcell = counter Then
levelcell.EntireRow.Font.ColorIndex = myStartColor
levelcell.EntireRow.Font.Size = myStartSize
End If
Next levelcell

counter = counter + 1
myStartColor = myStartColor + 1

If myStartSize > 7 Then
myStartSize = myStartSize - 1
Else: myStartSize = 7
End If

'Skip The Font Color Yellow, Hard to see
If myStartColor = 6 Then myStartColor = 7
If myStartColor = 19 Then myStartColor = 20
Loop


'Choose outline settings to use
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With


'Reset Counters
counter = 1
mylevel = 1

'Sort and Set Outline levels
Do While counter <= myHighLevel
For Each levelcell In ActiveSheet.Range("A2:A" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row)

If levelcell = counter Then
levelcell.EntireRow.OutlineLevel = mylevel + 1
End If

Next levelcell
mylevel = mylevel + 1
counter = counter + 1

'Stop outline from passing Maximum level of 8
If mylevel = 8 Then mylevel = 7

Loop



Application.ScreenUpdating = True

'************************************************************************** ***********'

' End the program by saving the file
BMCPFileName = Application.GetSaveAsFilename(strPart, "Microsoft Excel Workbooks (*.xls), *.xls")

If BMCPFileName <> "False" Then
ActiveWorkbook.SaveAs Filename:= _
BMCPFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End If
'************************************************************************** *************'

End Sub



[/vba]

input txt file starts like this:

===============================================
From: sender@email.com
Sent: Wednesday, April 1, 2009 2:39 PM
To: recipient@mail.com
Subject: BMCP


00~ ~ML-9A1WFA78-2 ~ ~0000.00000~000000.00000~EA~TERMAL ~9~6~TM5M00 ~090415~000000~N/A~00000~00000~Y~000001~ ~00000000000~000000000000~000000000000~000000000000~000000000000~N~
===============================================


... any ideas? thanks!

[mdmackillop]

The levelcell variable is created here
[vba]
'Indent the rest of the rows by their value
For Each levelcell In ActiveSheet.Range("A3:A" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row)
If levelcell <= 15 Then levelcell.InsertIndent levelcell
Next levelcell

[/vba]
It has not been declared.
Add "Option Explicit" before your code then Debug/Compile to check for other undeclared variables and Dim them as required.

The error arises if levelcell is empty, as you cannot set IndentLevel to an empty string. Add a check for this in the code

[VBA]
Dim levelcell
For Each levelcell In ActiveSheet.Range("A3:A" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row)
If levelcell <= 15 And levelcell <> "" Then levelcell.InsertIndent levelcell
Next levelcell

[/VBA]

[robnet77]

hey thanks a lot, a really quick reply indeed!

I'll try that and post the outcome... much appreciated!

[robnet77]

ops... was forgetting than in debug mode the value of levelcell at the moment of the error was 0, not nil, so the revised code hasn't helped...

[mdmackillop]

InsertIndent does not like 0
Try
[VBA]
For Each levelcell In ActiveSheet.Range("A3:A" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row)
If levelcell <= 15 Then levelcell.IndentLevel = levelcell
Next levelcell

[/VBA]

[mdmackillop]

Some suggestions to streamline your code. Avoid Activate and Select
[vba]
'For
Range("A1:L1").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
'Use
With Range("A1:L1")
.Font.Bold = True
.Interior.ColorIndex = 15
End With
'For
Columns("F:F").Select
Selection.Cut
Columns("D").Select
Selection.Insert Shift:=xlToRight
'Use
Columns("F:F").Cut
Columns("D").Insert

'Make sure sheet name doesn't contain illegal Characters (Rev 3)
KillColon:
intPosition = InStr(strPart, ":")
If intPosition > 0 Then
strPart = Left(strPart, intPosition - 1) & Right(strPart, Len(strPart) - intPosition)
GoTo KillColon
End If
'Try
Dim Illegals, Illeg
Illegals = Array(":", "\", "/") 'etc. add the rest
For Each Illeg In Illegals
strPart = Application.Substitute(strPart, Illeg, "")
Next

[/vba]

[robnet77]

Some suggestions to streamline your code. Avoid Activate and Select

... thanks again...

ehm... now getting e.m. some lines below:


ActiveSheet.Name = strPart

even if I fill in relevant lines of Excel sheet ... [ strPart = Cells(2, 3) ]

strPart keeps staying nil...