the below code is not working I'm getting Subscript out of range (Error 9)
Sub advnextract()
Sheets.Add(Before:=ActiveSheet).Name = "Resultado"
Set extractto = ThisWorkbook.Worksheets("Resultado").Range("A5:G5")
Selection.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"J1:J2"), CopyToRange:=extractto, Unique:=False
End Sub
Need help this is supposed to run a advanced filter and paste the result in the newly created sheet, the original table in the selection has data ranging from A1 to G11
As stated in the comments, the creation of a worksheet causes that to gain focus. Also you need to copy the titles to the sheet so excel knows where to put the values:
Sub advnextract()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim rng As Range
Dim extractto as range
Set rng = Selection 'It is better to set an actual range instead of Selection.
'Also Selection must have at least 7 columns or this will error.
'It also needs to include the column headers in the Selection.
Sheets.Add(Before:=ActiveSheet).Name = "Resultado"
Set extractto = ThisWorkbook.Worksheets("Resultado").Range("A5:G5")
extractto.Value = rng.Rows(1).Value
rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ws.Range( _
"J1:J2"), CopyToRange:=extractto, Unique:=False
End Sub
After trial and error and some insight into some logic here is the final result
Sub advnextract()
Dim rng As Range
Set rng = Selection
Sheets.Add(Before:=Sheets("Hoja1")).Name = "Resultado"
rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Hoja1").Range("J1:J2"), _
CopyToRange:=Sheets("Resultado").Range("A1"), Unique:=False
Sheets("Resultado").Activate
Columns("A:G").EntireColumn.AutoFit
Range("A1").Select
End Sub
I know it can be improved to be more efficient but for some reason I can't explain this is the code that works for me.
Related
Very new to VBA.
What I am trying to do:
1) Copy sheet from (source) workbook to active (master) workbook
2) Delete unnecessary columns of the copied data in the master workbook
3) Select cells with data in the master workbook and format as table (this is where I am stuck)
Sub first_sub()
'Open user Raw Data workbook
Workbooks.Open Filename:= _
"C:\Users\" & Environ("UserName") & "\Downloads\File.xls"
'Copy user Raw Data sheet to Data Master sheet
Workbooks("File.xls").Sheets("Records").Copy _
Before:=Workbooks("Macro Main.xlsm").Sheets(1)
'Close user Raw Data
Workbooks("File.xls").Close
End Sub
Sub Format()
Sheets("Records").Range("D:G,I:K,M:Y,AA:AA,AF:AM").EntireColumn.Clear
Sheets("Records").Range("D:G,I:K,M:Y,AA:AA,AF:AM").EntireColumn.Delete
End Sub
Sub MakeTable()
Dim tbl As ListObject
Dim rng As Range
Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStyleMedium3"
End Sub
The problem is in point 3. For some reasons, VBA selects columns up to "AM", even though I deleted them in previous sub, and as a result - I have the table full of empty columns all the way up to AM. How to solve this? Thank you in advance.
Check how .SpecialCells(xlLastCell) works: Range.SpecialCells Method (Excel)
I think your range variable rng is referencing from range Range("A1") to the last used cell in the column range AM
Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
Try adding this line after to check if the range is actually targeting your desired range:
rng.select
To solve this problem you can try:
Set rng = Range("A1").CurrentRegion
Or finding the last cell in column A...
Code:
Sub MakeTable()
Dim tbl As ListObject
Dim rng As Range
Set rng = Range("A1").CurrentRegion
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStyleMedium3"
End Sub
I am trying to run this simple code in VBA but it keeps giving me "extract range is not defined" error:
Private Sub CommandButton1_Click()
'Dim rng As Range
Dim RowLast As Long
Dim perporig As Workbook
count = 0
Set perporig = Workbooks.Open("\\Etnfps02\vol1\DATA\Inventory\Daily tracking\perpetual.xlsx", , ReadOnly)
With perporig.Sheets("perpetual")
.AutoFilterMode = False
RowLast = .Cells(Rows.count, "A").End(xlUp).row
'Set rng = .Range("C4:C" & RowLast)
Range("A3:J" & RowLast).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("N1:N6"), Unique:=False 'have also tried Range("A3:J3"), doesn't work.
End With
ThisWorkbook.Sheets("myperpetual").Range("A5", "J5").PasteSpecial xlPasteValues
End Sub
I am trying to copy from a file with data starting from A4:J4 to some A16000:J16000. I have to filter the values in column C to a range I have specified in the worksheet in range N1:N6.
FYI: Table header A4 is empty, and B4:J4 have relevant headers in them.
Also please let me know if my copy-paste method is wrong, or for some reason wouldn't work as expected.
EDIT: I also tried adding a header in column A , i.e. cell A3. Still doesn't work.
My range N1:N6 is a list of numbers, but I am sure the mistake lies there. It doesn't specify which column to apply filter on.
Once you are inside the With perporig.Sheets("perpetual") ... End With block, preface all Range objects and Range.Cells property references with a period (aka . or full stop).
With perporig.Sheets("perpetual")
.AutoFilterMode = False
RowLast = .Cells(Rows.count, "A").End(xlUp).row
'Set rng = .Range("C4:C" & RowLast)
.Range("A3:J" & RowLast).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("N1:N6"), Unique:=False
End With
Note .Range("C4:C"... and .Range("N1:N6") prefaced with a period. This indicates that the parent worksheet of the range(s) are defined by the worksheet named in the With ... End With statement. Without it, Excel is making a guess as to which worksheet the range belongs to; typically this would be the ActiveSheet property.
I am new to VBA and I am trying to write some code that selects gets the range of all of the cells in a different worksheet than the current one, prints it in a message box (for testing purposes), and returns to the original sheet. I intend to use this range to create a pivot table in the new sheet, and so In the end it needs to be of the form "R1C1:R929C25" To do this, I used code that I found here:
How do you select the entire Excel sheet with Range using Macro in VBA?
This is the code that I have so far:
Sheets("My_Sheet_Name").Cells.Select
MsgBox (Str(Range(Cells.Address)))
Sheets(Sheets.Count).Select
However, this returns an error:
Run-time error '1004':
Select method of Range class failed.
Edit:
I have gotten the code to get the range, yet how do I make it into the form "R1C1:R929C25"?
COMPLETED WORKING CODE:
Dim rng As Range
Set rng = Sheets("My_Sheet").UsedRange
Dim rc_range
rc_range = "R" & Trim(Str(rng.Rows.Count)) & "C" & Trim(Str(rng.Columns.Count))
MsgBox (rc_range)
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"My_Sheet!R1C1:" & rc_range, Version:=xlPivotTableVersion10). _
CreatePivotTable TableDestination:=ActiveSheet.Name + "!R4C4",
TableName:=inputValue + "_PivotTable" _
, DefaultVersion:=xlPivotTableVersion10
You have two options. First, you can use a variable to store the range upon which you hope to act. If it's a one time procedure, variables aren't necessary, but if it's a repetitive task, or involves multiple references, use a variable.
Option two is to refer directly to the other range without a variable. Again, use this if it's only a one time action, such as showing a messagebox.
First example:
Set rng = Sheets("My_Sheet").Cells
msgbox(rng.address)
Second example:
msgbox(Sheets("My_Sheet").Cells.Address)
One thing to note, the Sheet.Cells property returns all of the cells on the applicable sheet. So it would always be $A$1:$XFD$1048576
If you only want cells that are actually storing data, try using the UsedRange property, such as:
Set rng = Sheets("My_Sheet").UsedRange
msgbox(rng.address)
Per the updates and the changes in the comments, I'm including the full set of code to declare a range, and use that range in a Pivot Table to be used in a new sheet. Please note, I didn't perform full error checking, so that should be added to the code. For example, check if the new sheet name already exists, or if the pivot table name already exists, and if so, handle accordingly.
Sub CreatePivotFromDynamicRange()
Dim wsNew As Worksheet
Dim rngData As Range
Dim rngDestination As Range
'Add a new worksheet to store the pivot table
'[NOTE] if sheet named "PivotSheet" already exists it will throw error
Set wsNew = Worksheets.Add()
wsNew.Name = "PivotSheet"
'Define the range with the data needed for the pivot
Set rngData = Sheets("My_Data").UsedRange
'define the pivot destination
Set rngDestination = wsNew.Range("A5")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData, _
Version:=xlPivotTableVersion14).CreatePivotTable tabledestination:=rngDestination, _
tablename:="NewPivot", defaultVersion:=xlPivotTableVersion14
End Sub
You can't select cells from a sheet you are not actively on, but you can reference them. What do you want to do with the cells in "My_Sheet_Name"
If you want the range address from a different sheet and don't know the last row or last column then you can use this code.
Sub SelectLastCellInInSheet()
Dim sh As Worksheet
Dim Rws As Long, Col As Integer, r As Range, fRng As Range
Set sh = Sheets("My_Sheet_Name")
With sh
Set r = .Range("A1")
Rws = .Cells.Find(what:="*", after:=r, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Col = .Cells.Find(what:="*", after:=r, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set fRng = .Range(.Cells(1, 1), .Cells(Rws, Col))
End With
MsgBox fRng.Address
End Sub
I have an excel table with several columns two of which I am interested in. What I am trying to do is filter the first column with a specific criterion and then copy the visible values from the other column into a range object. After that I need to remove duplicates. The problem is I get an error. Here's the code. There are a lot of duplicates. Please tell me what's wrong or suggest a better way to achieve the task I'm trying to do.
Sub Begin()
Dim tbl As ListObject
Set tbl = Worksheets("Sheet1").ListObjects("Table1")
WorkSheet.AutoFilterMode = False
tbl.Range.AutoFilter Field:=8, Criteria1:="DUKESTREET_II-2"
Dim rng1 As Range
Set rng1 = tbl.ListColumns("TGT CELL NAME").DataBodyRange.SpecialCells(xlCellTypeVisible)
MsgBox rng1.Count
rng1.RemoveDuplicates Columns:=1, Header:=xlNo
MsgBox rng1.Count
End Sub
You're off to a great start, but unfortunately as #siddharth-rout pointed out .RemoveDuplicates will not work on a non-contiguous range.
In this case, to collect the all the unique cell values from the "TGT CELL NAME" column, you could use a collection (MSDN link):
Sub Begin()
Dim tbl As ListObject
Dim rng1 As Range, RngIdx As Range
Dim MySheet As Worksheet
Dim UniqueTGTCells As Collection
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
Set tbl = MySheet.ListObjects("Table1")
'only turn off auto filter mode if it's already set to true
If MySheet.AutoFilterMode = True Then
MySheet.AutoFilterMode = False
End If
tbl.Range.AutoFilter Field:=8, Criteria1:="DUKESTREET_II-2"
Set rng1 = tbl.ListColumns("TGT CELL NAME").DataBodyRange.SpecialCells(xlCellTypeVisible)
MsgBox rng1.Count
'populate the collection object
Set UniqueTGTCells = New Collection
For Each RngIdx In rng1
On Error Resume Next
UniqueTGTCells.Add LCase(CStr(RngIdx.Value)), LCase(CStr(RngIdx.Value))
On Error GoTo 0
Next RngIdx
'message the size of the collection
MsgBox UniqueTGTCells.Count
End Sub
Here are our message boxes:
My own solution to this old post below, in case anybody struggle again with that.
Note that I translated my working code into the posted one without testing, but I guess the idea is simple enough to be applied anyway.
Sub Begin()
Dim tbl As ListObject
Set tbl = Worksheets("Sheet1").ListObjects("Table1")
WorkSheet.AutoFilterMode = False
tbl.Range.AutoFilter Field:=8, Criteria1:="DUKESTREET_II-2"
' Sort to make sure filtered view will be contiguous
tbl.range.sort Key1:=tbl.range.cells(1,8), Order1:=xlAscending, Header:=xlYes
Dim rng1 As Range
Set rng1 = tbl.ListColumns("TGT CELL NAME").DataBodyRange.SpecialCells(xlCellTypeVisible)
MsgBox rng1.Count
' Using Areas(1) does the trick (there is only 1 area - no gaps - thanks to sorting)
rng1.Areas(1).RemoveDuplicates Columns:=1, Header:=xlNo
MsgBox rng1.Count
End Sub
I have a list of names in Column A in a worksheet named "Email"
I want to populate a userform ListBox with the names Column A. However, I can't specify a fixed range as this list will grown and shrink. So how do I get the userform to populate the list with the correct number of items?
This is what I am currently trying but is not working (I'm sure it will be obvious to some people on here as to why not), I also saw another example using a simple For loop but I am unable to find the example again to show you.
Private Sub UserForm_Initialize()
Dim rngName As Range
Dim rng1 As Range
Dim rng2 As Range
Dim ws As Worksheet
Set ws = Worksheets("Email")
Set rngName = ws.Range("A:A").Find(What:="*", LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set rng1 = ws.Range("A1")
On Error GoTo ErrorHandle
Me.lbUsed.List = Range(rng1 & ":" & rngName).Value
ErrorHandle:
End Sub
EDIT:
I now have the following code but it is failing to work when I load the userform:
Private Sub UserForm_Initialize()
Dim rngName As Range
Dim rng1 As Range
Set rngName = Worksheets("Email").Range("A:A").Cells.Find(What:="*", LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set rng1 = Worksheets("Email").Range("A1:" & rngName.Address)
Me.lbUsed.List = Worksheets("Email").Range(rng1).Value
End Sub
Can anyone point me in the correct direction?
If you want to populate your listbox with all of the items in column A (assuming that these are in a continuous range), you could do this simply by modifying you code like this:
Private Sub UserForm_Initialize()
Dim rngName As Range
Dim ws As Worksheet
Dim i As Integer
Set ws = Worksheets("Email")
For i = 1 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row Step 1
If ws.Cells(i, 1).Value <> vbNullString Then Me.lbUsed.AddItem ws.Cells(i, 1).Value
Next i
End Sub
Point the RowSource property of the ListBox to dynamic Named Range in your spreadsheet. As you add or remove items to the range, the list will automatically pull in new items to the listbox. There's no need to write any code implement this requirement.
This is an old question, but I feel this second comment is good. I would like to add a little to it to help people achieve the described answer:
Create (ctrl + t) a table and open Formulas>Name Manager
Select doublec-click the table in the list of names and name it
In your userform, enter the name of the table (that you named it in 2.) in RowSource:
When you open the form you should see all the items in the table listed in the listbox:
If you add to the table you add to that listbox's list,
Here's a little code example to remove an item and reset the table size to fit:
Sub ChangeTableSize()
Dim n As Long
Dim Tbl As ListObject
Set Tbl = Sheets(8).ListObjects(9)
With Tbl
n = .DataBodyRange.Rows.Count
.DataBodyRange(20, 1).ClearContents
.Resize Range(Tbl.DataBodyRange.Resize(n, 1).Offset(-1, 0).Address)
End With
End Sub
and Here's one to add to the table:
Sub AddtoTable()
Dim n As Long
Dim Tbl As ListObject
Set Tbl = Sheets(8).ListObjects(9)
With Tbl
n = .DataBodyRange.Rows.Count
Tbl.DataBodyRange(n + 1, 1) = "New"
End With
End Sub
Hope it is found to be useful!