I'm having trouble debugging Error 450 in my code. With 17 ranges, the code is running fine, but when more ranges are added, it shows Error 450 Wrong number of arguments or invalid property assignment. Please have a look at the code. The first line is highlighted and 'Union' also when the error is displayed.
Sub Set_PrintArea()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng10 As Range
Dim rng11 As Range
Dim rng12 As Range
Dim rng13 As Range
Dim rng14 As Range
Dim rng15 As Range
Dim rng16 As Range
Dim rng17 As Range
Dim rng18 As Range
Dim rng19 As Range
Dim rng20 As Range
Dim rng21 As Range
Dim rng22 As Range
Dim rng23 As Range
Dim rng24 As Range
Dim rng25 As Range
Dim rng26 As Range
Dim rng27 As Range
Dim rng28 As Range
Dim rng29 As Range
Dim rng30 As Range
Dim rng31 As Range
Dim rng32 As Range
Dim rng33 As Range
Dim rng34 As Range
Dim rng35 As Range
With Sheets("Performance")
Set rng1 = .Range("$A$1:$U$13")
Set rng2 = .Range("$B$15:$Z$52")
Set rng3 = .Range("$B$55:$Z$92")
Set rng4 = .Range("$B$95:$Z$132")
Set rng5 = .Range("$B$135:$Z$172")
Set rng6 = .Range("$B$175:$Z$212")
Set rng7 = .Range("$B$215:$Z$252")
Set rng8 = .Range("$B$255:$Z$292")
Set rng9 = .Range("$B$295:$Z$332")
Set rng10 = .Range("$B$335:$Z$372")
Set rng11 = .Range("$B$374:$Z$407")
Set rng12 = .Range("$B$410:$Z$443")
Set rng13 = .Range("$B$446:$Z$479")
Set rng14 = .Range("$B$482:$Z$515")
Set rng15 = .Range("$B$518:$Z$551")
Set rng16 = .Range("$B$554:$Z$587")
Set rng17 = .Range("$B$590:$S$610")
Set rng18 = .Range("$B$613:$V$642")
Set rng19 = .Range("$B$650:$U$662")
Set rng20 = .Range("$B$664:$Z$701")
Set rng21 = .Range("$B$704:$Z$741")
Set rng22 = .Range("$B$744:$Z$781")
Set rng23 = .Range("$B$784:$Z$821")
Set rng24 = .Range("$B$824:$Z$861")
Set rng25 = .Range("$B$864:$Z$901")
Set rng26 = .Range("$B$904:$Z$941")
Set rng27 = .Range("$B$944:$Z$981")
Set rng28 = .Range("$B$984:$Z$1021")
Set rng29 = .Range("$B$1023:$AD$1066")
Set rng30 = .Range("$B$1069:$AD$1112")
Set rng31 = .Range("$B$1115:$AD$1158")
Set rng32 = .Range("$B$1161:$AD$1204")
Set rng33 = .Range("$B$1207:$AD$1250")
Set rng34 = .Range("$B$1253:$AD$1296")
Set rng35 = .Range("$B$1299:$S$1323")
With .PageSetup
.PrintArea = Union(rng1, rng2, rng3, rng4, rng5, rng6, rng7, rng8, rng9, rng10, rng11, rng12, rng13, rng14, rng15, rng16, rng17, rng18, rng19, rng20, rng21, rng22, rng23, rng24, rng25, rng26, rng27, rng28, rng29, rng30, rng31, rng32, rng33, rng34, rng35).Address
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
.PrintPreview
End With
End Sub
Thanks in advance.
According to msdn, http://msdn.microsoft.com/en-us/library/office/ff834621(v=office.14).aspx
Union can only accept 30 parameters
Syntax
expression .Union(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)
To overcome this, you can split that 35 ranges into 2 sets.
e.g.
union1 = union(rng1, rng2, ... , rng30)
union2 = union(rng31, rng32, ... , rng35)
unionFinal = union(union1, union2)
You have hit two limits in Excel: maximum parameters for Union (as others have said) and the string length limit for PrintArea of 255 characters.
Your print area address is < 255 long if you don't use absolute addressing
Try this
Sub Demo()
ReDim rng(1 To 35)
Dim rngPrintArea As Range
Dim i As Long
With Sheets("Performance")
Set rng(1) = .Range("$A$1:$U$13")
Set rng(2) = .Range("$B$15:$Z$52")
Set rng(3) = .Range("$B$55:$Z$92")
Set rng(4) = .Range("$B$95:$Z$132")
Set rng(5) = .Range("$B$135:$Z$172")
Set rng(6) = .Range("$B$175:$Z$212")
Set rng(7) = .Range("$B$215:$Z$252")
Set rng(8) = .Range("$B$255:$Z$292")
Set rng(9) = .Range("$B$295:$Z$332")
Set rng(10) = .Range("$B$335:$Z$372")
Set rng(11) = .Range("$B$374:$Z$407")
Set rng(12) = .Range("$B$410:$Z$443")
Set rng(13) = .Range("$B$446:$Z$479")
Set rng(14) = .Range("$B$482:$Z$515")
Set rng(15) = .Range("$B$518:$Z$551")
Set rng(16) = .Range("$B$554:$Z$587")
Set rng(17) = .Range("$B$590:$S$610")
Set rng(18) = .Range("$B$613:$V$642")
Set rng(19) = .Range("$B$650:$U$662")
Set rng(20) = .Range("$B$664:$Z$701")
Set rng(21) = .Range("$B$701:$Z$741")
Set rng(22) = .Range("$B$744:$Z$781")
Set rng(23) = .Range("$B$784:$Z$821")
Set rng(24) = .Range("$B$824:$Z$861")
Set rng(25) = .Range("$B$864:$Z$901")
Set rng(26) = .Range("$B$904:$Z$941")
Set rng(27) = .Range("$B$944:$Z$981")
Set rng(28) = .Range("$B$984:$Z$1021")
Set rng(29) = .Range("$B$1023:$AD$1066")
Set rng(30) = .Range("$B$1069:$AD$1112")
Set rng(31) = .Range("$B$1115:$AD$1158")
Set rng(32) = .Range("$B$1161:$AD$1204")
Set rng(33) = .Range("$B$1207:$AD$1250")
Set rng(34) = .Range("$B$1253:$AD$1296")
Set rng(35) = .Range("$B$1299:$S$1323")
Set rngPrintArea = rng(1)
For i = 2 To 35
Set rngPrintArea = Union(rngPrintArea, rng(i))
Next
With .PageSetup
.PrintArea = rngPrintArea.Address(False, False)
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End With
End Sub
Shorter...
Sub Set_PrintArea()
Dim rng As Range, x As Long, arr
'add all your ranges here...
arr = Array("$A$1:$U$13", "$B$15:$Z$52", "$B$55:$Z$92", "$B$95:$Z$132")
With Worksheets("Performance")
Set rng = .Range(arr(LBound(arr)))
For x = LBound(arr) + 1 To UBound(arr)
Set rng = Application.Union(rng, .Range(arr(x)))
Next x
With .PageSetup
.PrintArea = rng.Address
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
.PrintPreview
End With
End Sub
Related
I want to delete a row once I've copied it to another location. There are lots of posts for this issue; I'm not sure why none of them are working in my specific situation.
Sub Transition_Queue_to_Other()
Dim QueueSheet As Worksheet
Set QueueSheet = ThisWorkbook.Worksheets("Project Queue")
Dim TableQueue As ListObject
Set TableQueue = QueueSheet.ListObjects("TableQueue")
Dim TransColumn As Range
Set TransColumn = QueueSheet.Range("TableQueue[Transition]")
Dim Trans_Queue_Row As Range
Dim i As Integer
With TransColumn
For i = 1 To .Count
If InStr(1, .Rows(i).Value, "NPD") > 0 Then
Dim NPDSheet As Worksheet
Set NPDSheet = ThisWorkbook.Worksheets("NPD")
Dim TableNPD As ListObject
Set TableNPD = NPDSheet.ListObjects("TableNPD")
Set Trans_Queue_Row = TableQueue.DataBodyRange.Rows(i)
Set Trans_NPD_Row = TableNPD.ListRows.Add.Range
Trans_NPD_Row.Cells(, 1).Value = Trans_Queue_Row.Cells(, 2).Value
'Now, how do I delete each Trans_Queue_Row after I've copied the info from it to the Trans_NPD_Row? I've tried several different ways with no success, including:
'Trans_Queue_Row.Delete
'Trans_Queue_Row.Range.Delete
'Trans_Queue_Row.Select
'Selection.Delete
Try this Code:
Sub Transition_Queue_to_Other()
Dim QueueSheet As Worksheet
Set QueueSheet = ThisWorkbook.Worksheets("Project Queue")
Dim TableQueue As ListObject
Set TableQueue = QueueSheet.ListObjects("TableQueue")
Dim TransColumn As Range
Set TransColumn = QueueSheet.Range("TableQueue[Transition]")
Dim Trans_Queue_Row As Range
Dim i As Integer
Dim NPDSheet As Worksheet
Set NPDSheet = ThisWorkbook.Worksheets("NPD")
Dim TableNPD As ListObject
Set TableNPD = NPDSheet.ListObjects("TableNPD")
With TransColumn
For i = .Count To 1 Step -1
If InStr(1, .Rows(i).Value, "NPD") > 0 Then
Set Trans_Queue_Row = TableQueue.DataBodyRange.Rows(i)
Set Trans_NPD_Row = TableNPD.ListRows.Add.Range
Trans_NPD_Row.Cells(, 1).Value = Trans_Queue_Row.Cells(, 2).Value
Trans_Queue_Row.EntireRow.Delete xlShiftUp
End If
Next
End With
End Sub
Going from bottom to Up and deleting the Row using EntireRow.Delete
I am creating a macro that is supposed to separate and add new worksheets based off one worksheet with all the data in it.
It won't run and I'm not sure why.
My code keeps hitting a Run Time Error '9': Script out of range. I'm not sure if it has something to do with the first sub or the second sub.
The error occurs on line 16:
Set wsMain = wbMain.Sheets("MAIN")
First sub:
Option Explicit
Sub main()
Dim wbMain As Workbook
Dim wsMain As Worksheet
Dim rngMain As Range
Dim RngCategoryOne As Range
Dim RngCategoryTwo As Range
Dim RngCategoryThree As Range
Dim RngCategoryFour As Range
Dim RngCategoryFive As Range
Dim RngCategorySix As Range
Dim rng As Range
Dim SheetNames As Variant
Dim str As Variant
Set wbMain = ActiveWorkbook
Set wsMain = wbMain.Sheets("MAIN")
Set rngMain = wsMain.Range("F2:F3000")
For Each rng In rngMain
Select Case rng
Case "HO NMX_AMO", "HO NMX_EUR", "WTI NMX", "DIESEL OHR EIA_AMO"
If RngCategoryOne Is Nothing Then
Set RngCategoryOne = rng
Else
Set RngCategoryOne = Union(rng, RngCategoryOne)
End If
Case "WTI NMX_AMO"
If RngCategoryTwo Is Nothing Then
Set RngCategoryTwo = rng
Else
Set RngCategoryTwo = Union(rng, RngCategoryTwo)
End If
Case "NG HH NMX"
If RngCategoryThree Is Nothing Then
Set RngCategoryThree = rng
Else
Set RngCategoryThree = Union(rng, RngCategoryThree)
End If
Case "RBOB NMX_EUR", "RBOB NMX_AMO"
If RngCategoryFour Is Nothing Then
Set RngCategoryFour = rng
Else
Set RngCategoryFour = Union(rng, RngCategoryFour)
End If
Case "GO ICE_AMO"
If RngCategoryFive Is Nothing Then
Set RngCategoryFive = rng
Else
Set RngCategoryFive = Union(rng, RngCategoryFive)
End If
Case "C3 CONW INW OPIS_APO, C3 MBEL TET OPIS_APO"
If RngCategorySix Is Nothing Then
Set RngCategorySix = rng
Else
Set RngCategorySix = Union(rng, RngCategorySix)
SheetNames = Array("AT, LB, LC, AS", "AO", "LN", "RF, RA", "ULA2", "8K, BO")
For Each str In SheetNames
Call AddNewWorksheet(wbMain, str)
Next str
wbMain.Sheets("AT, LB, LC, AS").Range("A1:A" & RngCategoryOne.Count) = RngCategoryOne.Value
wbMain.Sheets("AO").Range("A1:A" & RngCategoryTwo.Count) = RngCategoryTwo.Value
wbMain.Sheets("LN").Range("A1:A" & RngCategoryThree.Count) = RngCategoryThree.Value
wbMain.Sheets("RF, RA").Range("A1:A" & RngCategoryFour.Count) = RngCategoryFour.Value
wbMain.Sheets("ULA2").Range("A1:A" & RngCategoryFive.Count) = RngCategoryFive.Value
wbMain.Sheets("8K, BO").Range("A1:A" & RngCategorySix.Count) = RngCategorySix.Value
wsMain.Activate
wsMain.Range("A1").Select
End If
End Select
Next
End Sub
Second Sub:
Sub AddNewWorksheet(ByRef wb As Workbook, ByVal wsName As Variant)
With wb.Sheets
.Add(after:=wb.Sheets(.Count)).Name = wsName
End With
End Sub
I'm looking to insert a new blank row after every instance of HDR in the sheet. I cannot figure out how to make the code move beyond the first instance to continue through the rest of the sheet.
Sub NewRowInsert()
Dim SearchText As String
Dim GCell As Range
SearchText = "HDR"
Set GCell = Cells.Find(SearchText).Offset(1)
GCell.EntireRow.Insert
End Sub
Try this code
Sub Test()
Dim a() As Variant
Dim found As Range
Dim fStr As String
Dim fAdd As String
Dim i As Long
fStr = "HDR"
Set found = Cells.Find(What:=fStr, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)
If Not found Is Nothing Then
fAdd = found.Address
Do
ReDim Preserve a(i)
a(i) = found.Offset(1).Address
i = i + 1
Set found = Cells.FindNext(found)
Loop Until found.Address = fAdd
End If
If i = 0 Then Exit Sub
For i = UBound(a) To LBound(a) Step -1
Range(a(i)).EntireRow.Insert
Next i
End Sub
Another option
Sub Test()
Dim a() As Variant
Dim oRange As Range
Dim found As Range
Dim fStr As String
Dim fAdd As String
fStr = "HDR"
Set found = Cells.Find(What:=fStr, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)
If Not found Is Nothing Then
fAdd = found.Address
Do
If oRange Is Nothing Then Set oRange = found.Offset(1) Else Set oRange = Union(oRange, found.Offset(1))
Set found = Cells.FindNext(found)
Loop Until found.Address = fAdd
End If
If Not oRange Is Nothing Then oRange.EntireRow.Insert
End Sub
Sub NewRowInsert()
Dim SearchText As String
Dim GCell As Range
Dim NumSearches As Integer
Dim i As Integer
SearchText = "HDR"
NumSearches = WorksheetFunction.CountIf(Cells, SearchText)
Set GCell = Cells(1, 1)
For i = 1 To NumSearches
Set GCell = Cells.Find(SearchText, After:=GCell, SearchOrder:=xlByRows, SearchDirection:=xlNext).Offset(1)
GCell.EntireRow.Insert
Next i
End Sub
Am trying to programme a lookup across 2 workbook with workbook path and name linked to cell for dynamic updates ... my current code is getting an error:
"object does not support property or method" on line 29 set lookfor
Can you help me resolve this?
Sub Lookup()
Dim wb1 As String, wb2 As String
Dim wbook1 As Workbook, wbook2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lookFor As Range
Dim srchRange As Range
Dim wb1name As String, wb2name As String
Dim wb1path As String, wb2path As String
Dim sFormulaPre As String, sFormulaSuff As String
Dim rowstart As Long
wb1name = Workbooks("r.xlsm").Sheets("Front sheet").Range("B3").Text
wb2name = Workbooks("r.xlsm").Sheets("Front sheet").Range("AA1").Text
wb1path = Workbooks("r.xlsm").Sheets("Front sheet").Range("AB1").Text
wb2path = Workbooks("r.xlsm").Sheets("Front sheet").Range("AB1").Text
wb1 = wb1path & wb1name
wb2 = wb2path & wb1name
Set wbook1 = Workbooks(wb1name)
Set wbook2 = Workbooks(wb2name)
Set ws1 = wbook1.Sheets("DATA1")
Set ws2 = wbook2.Sheets("DATA")
Set lookFor = wbook2.ws2.Range("$G:$J")
Set srchRange = wbook1.ws1.Range("$A:$E")
Dim bIsEmpty As Boolean
sFormulaPre = "vlookup(D"
sFormulaSuff = ",srchRange, 2,FALSE)"
If IsEmpty(Workbooks("r.xlsm").Sheets("Front sheet").Range("Y1")) = False Then
With wbook2.ws2
rowstart = .Cells(G, 11)
MsgBox sFormulaPre & rowstart & sFormulaSuff
End With
ElseIf IsEmpty(Workbooks("Rates, percentages calculator.xlsm").Sheets("Front sheet").Range("Y1")) = True Then
bIsEmpty = True
End If
End Sub
You already Set your ws2 worksheet object to wbook2, with this line Set ws2 = wbook2.Sheets("DATA")
so change your :
Set lookFor = wbook2.ws2.Range("$G:$J")
to:
Set lookFor = ws2.Range("$G:$J")
The same goes for:
Set srchRange = wbook1.ws1.Range("$A:$E")
should be:
Set srchRange = ws1.Range("$A:$E")
And, change With wbook2.ws2
to: With ws2
I'm trying to figure out a problem in Excel. I am getting an Out of Memory error and I suspect that's not the problem but I don't really know.
Basically, I'm trying to make a macro that searches for a column within 5 tabs in a spreadsheet (the column can be in any of the 5 and it changes a lot) and when it finds it, does a vlookup match to return the column to the appropriate place in the master tab. Here is my code below which seems like it should work but I get the Out of Memory error. the line that is highlighted when I go to debug is the first Vrange = rB line in the if statement.
Dim i As Integer
Dim r As Range
'
Dim wsMaster As Worksheet: Set wsMaster = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("MasterTab")
Dim wsB As Worksheet: Set wsB = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("B")
Dim wsE As Worksheet: Set wsE = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("E")
Dim wsL As Worksheet: Set wsL = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("L")
Dim wsI As Worksheet: Set wsI = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("I")
Dim wsT As Worksheet: Set wsT = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("T")
'
Dim rBHeading As Range: Set rBHeading = wsB.Range("A2:ZA2")
Dim rEHeading As Range: Set rEHeading = wsE.Range("A2:ZA2")
Dim rLHeading As Range: Set rLHeading = wsL.Range("A2:ZA2")
Dim rIHeading As Range: Set rIHeading = wsI.Range("A2:ZA2")
Dim rTHeading As Range: Set rTHeading = wsT.Range("A2:ZA2")
'
Dim rB As Range: Set rB = wsB.Range("A:ZA")
Dim rE As Range: Set rE = wsE.Range("A:ZA")
Dim rL As Range: Set rL = wsL.Range("A:ZA")
Dim rI As Range: Set rI = wsI.Range("A:ZA")
Dim rT As Range: Set rT = wsT.Range("A:ZA")
'
Dim mf_iA_TEXT As String: mf_iA_TEXT = "iA"
'
If Application.CountIf(rBHeading, "iA") = 1 Then
Vrange = rB
Mrange = rBHeading
ElseIf Application.CountIf(rEHeading, "iA") = 1 Then
Vrange = rE
Mrange = rEHeading
ElseIf Application.CountIf(rLHeading, "iA") = 1 Then
Vrange = rL
Mrange = rLHeading
ElseIf Application.CountIf(rIHeading, "iA") = 1 Then
Vrange = rI
Mrange = rIHeading
Else
Vrange = rT
Mrange = rTHeading
End If
'
Dim mf_iA As Variant: mf_iA = Application.Match(mf_iA_TEXT, Mrange, 0)
'
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
MsgBox lastrow
End With
'
For i = 2 To lastrow
wsMaster.Cells(i, 2) = Application.VLookup(wsMaster.Cells(i, 1), Vrange, mf_iA, 0)
Next i
'
End Sub
I also tried to accomplish this with a case statement but I felt like I got further with the above code. If you could please let me know if this code is dumb, or if I can solve the Out of Memory error, I would greatly appreciate it. If I can get this to work, I will be copying the process with many many more columns, in case that matters. Thanks!!
To get you started, the first 56 lines of code could be written as,
Dim v As Long, vWSs As Variant, Mrange As Range, Vrange As Range, mf_iA as long
Dim wsMaster As Worksheet: Set wsMaster = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("MasterTab")
Dim mf_iA_TEXT As String: mf_iA_TEXT = "iA"
vWSs = Array("B", "E", "L", "I", "T")
With Workbooks("LBImportMacroTemplate.xlsm")
mf_iA = 0: Set Mrange = Nothing: Set Vrange = Nothing
For v = LBound(vWSs) To UBound(vWSs)
If CBool(Application.CountIf(.Sheets(vWSs(v)).Range("A2:ZA2"), mf_iA_TEXT)) Then
Set Mrange = .Sheets(vWSs(v)).Range("A2:ZA2")
Set Vrange = .Sheets(vWSs(v)).Range("A:ZA")
' added the column number assignment on the next line
mf_iA = application.match(mf_iA_TEXT, Mrange, 0)
Exit For
End If
Next v
End With
if mf_iA = 0 then msgbox "Stop here! " & mf_iA_TEXT & "not found!"
'assumed that Mrange and Vrange are not nothing at this point
' and that mf_iA is the numerical column index number for mf_iA_TEXT
'do something with them
Set Mrange = Nothing
Set Vrange = Nothing
Set wsMaster = Nothing
That takes you to the end of the If/ElseIf/End If where you can continue processing. The last three are just reminders to manually set the ranges and workbook object to nothing after you are done with them.