I am currently experimenting using VBA and autofilter to query a dataset (as per Populate Excel Data Validation Drop-Down From Data Range Condition Using VBA )
However I am having trouble using VBA to refer to the auto filter results.
How can I collect results without needing to copy and paste? (for example to store a result as a variable)
How can I check how many results have been found, and trigger a msg box when the auto filter produces no results?
Thanks for your help
You may use the special parameters xlCellTypeVisible and SpecialCells.
Sub Test()
Dim SheetERP As Worksheet
Set SheetERP = Worksheets("MyDatas") 'Sheet with data
Dim myTabela As Excel.ListObject
Set myTabela = SheetERP.ListObjects("CodeData") 'Named Table range
Dim qtd As Integer 'To count filtered data rows (only visible)
qtd = SheetERP.ListObjects("CodeData").DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible).Count
'OR
qtd = myTabela.DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible).Count
MsgBox qtd
Dim TFiltro As Range
Set TFiltro = SheetERP.UsedRange.SpecialCells(xlCellTypeVisible)
'OR
Set TFiltro = myTabela.DataBodyRange.SpecialCells(xlCellTypeVisible)
'Do what you want with TFiltro
End Sub
Related
I have some VBA code which needs to select Prod. Code, Lims#, SampleID, Log Date, District Name, Region, Machine ID, Ash, cNDF, CP, Ca, Cl from a pivot table.
When I use Entire row, I can select all the data that I need to make a clean paste into column A. However, now I'd like to paste into column
.PivotItems(PivotFieldName.Caption).DataRange.EntireRow.Select
I've attempted to do just data range, however it won't pull Prod.Code, Lims#, etc columns. It will only grab the analyte columns.
.PivotItems(PivotFieldName.Caption).DataRange.Select
I also tried to do a range off of the EntireRow, however then I can't figure out how to get last column or last row for that selected Prod. Code.
.PivotItems(PivotFieldName.Caption).DataRange.EntireRow.Range("A1:BB1").Select
How can I got about getting all columns for a Prod. code selected like the Entire Row method excluding the extra rows?
The Prod.Code Columns & Rows can shift in size depending on the data so I need to make it capable of grabbing the right range.
Further code structure:
Dim PvtTbl As PivotTable
Dim PvtFld As PivotField
Set PvtTbl = Sheets("NEP Pivot").PivotTables("NEP_Pivot")
Set PvtFld = PvtTbl.PivotFields("Prod. Code")
For Each PivotFieldName In PvtFld.PivotItems
'PivotFieldName.Caption represents "EHB"
If IsError(Application.Match(PivotFieldName.Caption, rngList, 0)) Then
With PvtFld
On Error Resume Next
.PivotItems(PivotFieldName.Caption).ShowDetail = True 'Show pivot item
.PivotItems(PivotFieldName.Caption).DataRange.EntireRow.Copy
Destination:=Sheets(PivotFieldName.Caption).Range("A3")
...
..
.
Use the .DataBodyRange property instead to get all the data within the pivot
PivotTable.DataBodyRange Property (Excel)
Returns a Range object that represents the range of values in a
PivotTable. Read-only.
Syntax
expression . DataBodyRange
expression A variable that represents a PivotTable object.
As you also want the row element you can do the following you can resize the data body range according to the difference in column count between the larger TableRange2 property and that inside pivot area. Be aware that grand totals etc may affect this but this shows you how to start thinking about it. There is also a TableRange1 property available with pivots.
Example pivot:
Code:
Option Explicit
Sub test()
Dim ws As Worksheet
Dim pvt As PivotTable
Dim columnsDifference As Long
Set ws = ActiveSheet
Set pvt = ws.PivotTables("PivotTable4")
columnsDifference = pvt.TableRange2.Columns.Count - pvt.DataBodyRange.Columns.Count
With pvt.DataBodyRange
Debug.Print .Offset(, -columnsDifference).Resize(.Rows.Count, .Columns.Count + columnsDifference).Address
End With
End Sub
I would recommend reading up on referencing pivottable ranges in VBA.
There are a variety of properties that you can use to determine ranges e.g. LabelRange and DataRange for fieldItems. You seems to have explored some of these. My experience has been that these are influenced by your pivottable layout and you will need to determine the current combination of methods to get your data.
For example, I used the following to get all the data for EHB with data laid out as follows:
Option Explicit
Sub test()
Dim ws As Worksheet
Dim pvt As PivotTable
Dim columnsDifference As Long
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Worksheets("mySheetName")
Set pvt = ws.PivotTables("NEP_Pivot")
columnsDifference = pvt.TableRange2.Columns.Count - pvt.DataBodyRange.Columns.Count
With pvt.DataBodyRange
Debug.Print pvt.PivotFields("Prod. Code").PivotItems("EHB").LabelRange.Offset(-1, 0).Resize(pvt.PivotFields("Prod. Code").PivotItems("EHB").LabelRange.Rows.Count, .Columns.Count + columnsDifference).Address
End With
End Sub
This produced the result
$C$11:$N$13
Notice how I have had to combine functions to get this result and if the pivottable layout gets changed this falls apart.
I was also able to write using:
With pvt.TableRange1
Debug.Print pvt.PivotFields("Prod. Code").PivotItems("EHB").LabelRange.Resize(pvt.PivotFields("Prod. Code").PivotItems("EHB").LabelRange.Rows.Count, .Columns.Count).Offset(-1, 0).Address
End With
I have a spreadsheet w/30 or so columns. My goal is to filter the set based on 1 column and my approach was the specify a range being just that column and then filter that range. I do have autofilters on every column and when i specify a field:=1 excel picks the first column...whcih is outside of my range. So it's always trying to filter on column "A"...not column "U" as desired. Am i mis-understanding how to use this field? i though it was an offset w/in a range.
here's a simple example
Dim r As Range
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("test")
sheet.Range("u1:u9").AutoFilter field:=1, Criteria1:="Will"
as an aside...is there a way to get a column number associated with the column letter? for example U --> 21. if so i could select the entire spreadsheet as the range and do an offset of 21
If you are applying filters to one column, you will have to clear the existing filters first.
Your tweaked code would be something like this and it will apply the filter to column U only...
Sub test()
Dim r As Range
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("test")
sheet.AutoFilterMode = False
sheet.Range("u1:u9").AutoFilter field:=1, Criteria1:="Will"
End Sub
OR
You may also apply the filters to all the columns and specify the field criteria correctly.
Give this a try...
Sub test2()
Dim r As Range
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("test")
Set r = sheet.Range("U1")
sheet.AutoFilterMode = False
sheet.Range("A1").CurrentRegion.AutoFilter field:=r.Column, Criteria1:="Will"
End Sub
Column 1 is in Sheet1 and column 2 is in Sheet2. If the value is not found , then highlight that cell. I am trying to do a vlookup comparing two columns. I think the Syntax is incorrect. Please see my code I was trying below:
Option Explicit
Sub VlookupColoums()
' declarations
Dim lookFor As Range
Dim srchRange As Range
Dim I As Long
Dim vtest As Variant
' start
Set lookFor = Sheets("Sheet1").Range("A13").End(xlUp)
Set srchRange = Sheets("Sheet2").Range("A2").End(xlUp)
vtest = Application.VLookup(lookFor.Rows.Count, srchRange.Rows.Count, 2, False)
' process
For I = 1 To lookFor.Rows.Count
If IsError(vtest) Then
srchRange.Interior.Color = 4
Else
Exit Sub
End If
Next I
End Sub
Assuming you have data on Sheet1!A1:A15 and Sheet2!A1:A10.
Also assuming you want to highlight unique cells (ones withouth at least one identical in the other list) on Sheet2.
Basically you want to format all the cells that if counted on the other list comes up with 0. The steps:
Select all the cells to be evaluated on Sheet2
Go to Home/Styles/Conditional Formatting
Select New Rule, then Use a formula to determine...
Enter this formula: =COUNTIF(Sheet1!$A$1:$A$5,A1)=0
Click on the Format button, and set up a formatting for the unique cells
OK
Profit. :)
So in MS Excel I've imported a table from a database in a SQL Server. I want to create a parameterized query where you have two cells. Say these two cells are G1 and G2. G1 takes a parameter/category and G2 takes a value from the parameter/category and queries the table you imported (essentially a WHERE clause that is dynamic from cell input). Can someone show me how to do this?
EDIT: Based on a chat session, we discovered that the first parameter is the column to be searched and the second parameter is the value to filter.
You can do what you want by filtering the table you imported.
Use the code below as your template. Modify it to reference the correct worksheets and ranges.
Sub FilterByParameter()
Dim wb As Workbook
Dim dataSheet As Worksheet
Dim parameterSheet As Worksheet
Dim rng As Range
Dim filterColumn As Long
Dim filterValue As String
Set wb = ThisWorkbook
' sheet that contains your table
Set dataSheet = wb.Sheets("Sheet1")
' sheet that contains your parameters
Set parameterSheet = wb.Sheets("Sheet2")
' range that contains your table, hard-coded here
' but can easily be set dynamically
Set rng = dataSheet.Range("A1:F78")
' get the column you are searching
filterColumn = parameterSheet.Range("G1").Value
' get the value you want to filter on
filterValue = parameterSheet.Range("G2").Value
' turn off autofilters if set
dataSheet.AutoFilterMode = False
' autofilter using your column and filter
rng.AutoFilter field:=filterColumn, Criteria1:=filterValue
' now you can do whatever you want to with the rows
' that remain after the autofilter was applied
End Sub
See Efficient way to delete entire row if... for an example of how to use the visible rows.
I have an Excel sheet on which I have created a list consisting of many values. Also I have created a macro which shows a userform in which those values are hard-coded.
Now I want that those values in the form to be automatically/programatically/dynamically added to my userform list, so that in the future, if I want to decrease the values from the list, then I would not have to change the macro again.
I have been searching for the answer but I have been unsuccessful in finding what I am looking for.
I have recorded this macro, but I don't know how to retrieve values from it:
Sub Macro7()
'
' Macro7 Macro
'
'
Range("E1").Select
ActiveSheet.Range("$A$1:$AE$175").AutoFilter Field:=5
End Sub
The macro you've specified will turn on autofiltering for your active worksheet. This will provide column headers that will allow the user to filter to something of interest.
Assuming that this kind of filtering of the worksheet is what you want, you can use something like:
Dim r As Range
'Note: set r to something useful, such as worksheet.Cells
Dim vis As Range
Set vis = r.SpecialCells(xlCellTypeVisible)
'now vis holds a special "Range" object referring to the visible cells.
'since (auto) filtering hides some cells, this vis range will help show only the cells that remain visible.
'the output of SpecialCells, you should assume holds a complex Range,
'which is composed of multiple Areas that are wrapped in one single Range object
'the separate areas help you distinguish the visible cells from the hidden cells
'fyi, various safety checks you can do: vis Is Range, vis Is Nothing
Dim a as Areas
Set a = r.Areas
Dim cr as Range
For Each cr in a
'cr refers to a single (i.e. normal and contiguous) area range
'where you can use cr.Row, cr.Column, cr.Rows.Count, cr.Columns.Count
Next
So when you do filtering, you can use SpecialCells(xlCellTypeVisible) to reveal the non-hidden cells, which are represented as have a range that wraps areas that represent contiguous ranges.
With a userform named UReports that has a listbox named lbxReport, use code like this to fill the listbox with values from column E
Sub ShowUf()
Dim ufReports As UReports
Dim rCell As Range
Dim colUnique As Collection
Dim i As Long
Set ufReports = New UReports
Set colUnique = New Collection
'loop through the cells in column E
For Each rCell In Sheet1.Range("E2", Sheet1.Cells(Sheet1.Rows.Count, 5).End(xlUp)).Cells
'Collections can't have duplicate keys, so we try to add all the values. If there
'are duplicates, the 'On Error' ignores them and we're left with a collection of
'only unique values from column E
On Error Resume Next
colUnique.Add rCell.Value, CStr(rCell.Value)
On Error GoTo 0
Next rCell
'loop through the collection and add them to the listbox
For i = 1 To colUnique.Count
ufReports.lbxReport.AddItem colUnique.Item(i)
Next i
'Show the form
ufReports.Show
End Sub