1. I noticed a mixture of &'s and +'s.
1a. I fixed them.
2. I think you need to cast your integers to strings (TopRow, NewLastRow, others).
2a. I cast them for you.
I cut your code exactly.
I added some comments that you will
see in green once you cut this and paste it.
I added casting
to your integers in Range fields.
If your code is correct it
will now work. If it still Err's then you have to look at some logic.
Use some debugging to message yourself e.g. MsgBox "trying out code
var:" & myvar
Function Material_Rollup()
MyfirstValue = 0
MyLastValue = 0
Cnt = 0
TopRow = 0
BottomRow = 0
CntDelRows = 0
NewLastRow = 0
Quantity = 0
loopCnt = 0
Dim MyBom As String
Dim MyRollup As String
Dim NextRow As String
MyBom = ActiveSheet.Name
If Val(Range("A2")) > 0 Or Val(Range("I1")) > 0 Then
MsgBox MyBom & " is not a BOM72 Work sheet or Material Rollup Sheet, Rollup Canceled."
Call GotoSheet
GoTo Cancel
End If
ReturnRows (Selection.Address)
MyfirstValue = My_First_Row
MyLastValue = My_Last_Row
If MyfirstValue = MyLastValue Then
Call BOM72ERR(3, "")
GoTo Cancel
End If
RetrySheet:
If Pick_Sheet = "Pick_Sheet_Cancel" Then
Sheets(MyBom).Select
GoTo Cancel
Else
MyRollup = Pick_Sheet
End If
'See if Rollup sheet name exist or is new
For Each sh In ActiveWorkbook.Sheets
If UCase(sh.Name) = UCase(MyRollup) Then
DoesSheetExist = 1
Exit For
Else
DoesSheetExist = 0
End If
Next
'If Sheet exist make sure its a Material Rollup Sheet
If DoesSheetExist = 1 Then
If Worksheets(MyRollup).Range("E1").Value <= 0 Then
MsgBox MyRollup & " is not a Material Rollup Sheet."
GoTo RetrySheet
End If
End If
'If sheet doesn't exist, build and format
If DoesSheetExist = 0 Then
Sheets.Add
ActiveSheet.Name = MyRollup
ActiveWindow.DisplayGridlines = False
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Worksheets("Data").Range("A4:W6").Copy (Worksheets(MyRollup).Range("A1"))
Range("a4").Select
ActiveWindow.FreezePanes = True
Range("A5").Select
TopRow = 4
'Does Range("E1") return an address or integer?
Dim myMessage = "Range("E1") return an address or integer? TopRow = "
Range("E1") = TopRow
MsgBox myMessage & TopRow
End If
Worksheets(MyRollup).Select
'
'TopRow = Address + 1? Does Range("E1") return an integer?
TopRow = (Range("E1") + 1)
MsgBox myMessage & TopRow
'Is Val(MyFirstValue), Val necessary, or help, or hinder?
BottomRow = ((Val(MyLastValue) - Val(MyfirstValue)) + 1) + Range("E1").Value
Cnt = TopRow
'Casting
Worksheets(MyBom).Range("B" + CStr(MyfirstValue) & ":H" & CStr(MyLastValue)).Copy (Worksheets(MyRollup).Range("B" & CStr(TopRow)))
'Delete Rows that are not Material Items (Look for Text in Mfg Column)
For Each C In Worksheets(MyRollup).Range("C" & CStr(TopRow) & ":C" & CStr(BottomRow))
If C.Value = "" Then
'Added Cast to summation
Rows(CStr((Cnt - CntDelRows))).Select
Selection.Delete Shift:=xlUp
CntDelRows = CntDelRows + 1
End If
Cnt = Cnt + 1
Next C
'Delete Rows with the Unit Price column colored Gray (Don't Rollup)
NewLastRow = (Cnt - (CntDelRows + 1))
Cnt = TopRow
CntDelRows = 0
'Casting
For Each C2 In Worksheets(MyRollup).Range("G" & CStr(TopRow) & ":G" & CStr(NewLastRow))
If C2.Interior.ColorIndex = 40 Then
Rows((Cnt - CntDelRows)).Select
Selection.Delete Shift:=xlUp
CntDelRows = CntDelRows + 1
End If
Cnt = Cnt + 1
Next C2
NewLastRow = (Cnt - (CntDelRows + 1))
'Sort Rollup by Part Number
'Casting
Range("A" & CStr(TopRow) & ":S" & CStr(NewLastRow)).Select
Selection.Sort Key1:=Range("D" & TopRow), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("B" & TopRow).Select
Cells.Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
End With
Range("A1").Select
Cnt = TopRow
cnt2 = (Cnt + 1)
CntDelRows = 0
loopCnt = 0
'Casting
'Rollup, Like Part Numbers, Combine Quantities and Delete Rows
For Each c1 In Worksheets(MyRollup).Range("D" & CStr(TopRow) + ":D" & CStr(NewLastRow))
NextRow = Range("D" & cnt2)
'Casting
If UCase(c1.Value) = UCase(NextRow) Then
Quantity = Range("E" & CStr(Cnt)) & Range("E" & CStr(cnt2))
Range("E" & CStr(cnt2)) = Quantity
'?Cast here? CStr(Cnt)?
Rows(Cnt).Select
Selection.Delete Shift:=xlUp
CntDelRows = CntDelRows + 1
Cnt = Cnt - 1
cnt2 = cnt2 - 1
Quantity = 0
End If
Cnt = (Cnt + 1)
cnt2 = (cnt2 + 1)
Next c1
NewLastRow = NewLastRow - CntDelRows
'Casting
'Sort Rollup by Manufacturer then Part Number
Range("A" & CStr(TopRow) & ":S" & CStr(NewLastRow)).Select
Selection.Sort Key1:=Range("C" & CStr(TopRow)), Order1:=xlAscending, Key2:=Range _
("D" & CStr(TopRow)), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
'Casting
Range("B" + CStr(TopRow)).Select
Worksheets("Data").Range("G8:W8").Copy Worksheets(MyRollup).Range("G" & CStr(TopRow) & ":G" & CStr(NewLastRow))
Sheets(MyRollup).Select
Columns("K:S").Select
Selection.ColumnWidth = 6
Columns("A").Select
Selection.ColumnWidth = 3
Columns("B").Select
Selection.ColumnWidth = 20
Columns("C:D").Select
Selection.ColumnWidth = 12
Columns("E:F").Select
Selection.ColumnWidth = 6
Columns("H").Select
Selection.ColumnWidth = 3
Range("K5").Select
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
'Casting
Range("E1") = NewLastRow '? CStr(NewLastRow) ? Might need here!
Range("A" & TopRow) = "WorkSheet: " & MyBom & " Rows: " & CStr(MyfirstValue) & " to " & CStr(MyLastValue)
Range("A" & CStr(TopRow)).Font.ColorIndex = 22
If TopRow > 5 Then
Range("B1") = "Multi-Rollup Sheet"
Else
Range("B1") = "Single-Rollup Sheet"
End If
Range("B" + CStr(TopRow)).Select
'Don't forget to value quantity column
Cancel:
End Function