Excel - VBA
I want to count how many rows there are after filtering the table.
How do I do this?
I have tried rows_count = Range("AX:AX").SpecialCells(xlCellTypeVisible).Count
but that gives me full number of rows there are in Excel 2010.
Once you've applied your filter, just use something like this:
rows_count = Worksheets("Sheet1").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
For example, I filled A2:C20 with =RAND() and used the following code:
Sub filter()
Dim sht As Worksheet
Dim rng As Range
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set rng = sht.Range("A1:C20")
sht.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="<0.5"
MsgBox sht.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
End Sub
This is due to that you're referring to the entire column instead of just your table. Try with
rows_count = Range(cells(1,"AX"), cells(cells(rows.count,"AX").end(xlup).row,"AX")).SpecialCells(xlCellTypeVisible).Count
It would be better to declare which sheet you're referrring to so use
With Sheets("Sheet1")
rows_count = Range(.Cells(1, "AX"), .Cells(.Cells(.Rows.Count, "AX").End(xlUp).Row, "AX")).SpecialCells(xlCellTypeVisible).Count
End With
Where Sheet1 is the name of your sheet you're referring to.
Or if you're using a table object you can get your answer with
With Sheets("Sheet1").ListObjects(1)
rows_count = .ListColumns(Columns("AX").Column).DataBodyRange.SpecialCells(xlCellTypeVisible).Count
End With
Related
I would highly appreciate someone's help with my case here. I'm aiming to write a macro that uses Vlookup to find Quantity and Price from Monthly reports to the Master File (35K Rows). However, I would like to apply the filter first (e.g. the Product File & Date column) before using the Vlookup. Is my approach so far correct? I'm able to apply the Autofilter function, but I'm struggling to:
Skip the header row
Create `For Each function´ to run the vlookup on the visible cells only
Please have a look at my code, and let me know how I could move forward with it.
Sub VolumeVlookup1()
'Source Workbook & Worksheet
Dim ConsWB As Workbook
Dim ConsWS As Worksheet
Dim ReportingFile As Range
Set ConsWB = Workbooks.Open("https://Sharepoint.xlsm")
Set ConsWS = Sheets("ConsolidatedReports")
ConsWS.Select
Set ConsTable = ConsWS.ListObjects("ConsolidatedReports")
Set ReportingFile = ConsWS.Range("I1")
'Master Data File
Dim MasterFile As Workbook
Dim Oiv1 As Worksheet
Dim tbl3 As ListObject
'Dim rng As Range, Ffr As Range
Set MasterFile= Workbooks.Open("C:\Users\O\Downloads\XYZ One.xlsx")
Set Oiv1 = Sheets("Oiv One")
Set tbl3 = Oiv1.ListObjects("Table3")
'Starting Point Quantity Column in the Master File
Set rng = Oiv1.Range("K1")
Dim Lastrow As Long
'Filtering Master Data table
With tbl3.Range
.AutoFilter Field:=9, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic
.AutoFilter Field:=38, Criteria1:=ReportingFile
End With
Lastrow = ActiveSheet.UsedRange.Rows.Count
' Trying to assign dynamic first cell in the quantity column *Note that 11 is the Column Index number of Quantity in the Master Data*
Set Ffr = Rng.SpecialCells(xlCellTypeVisible).Cells(2, 11)
'-9 is the Product ID the value I need to look it up
Ffr.Value = WorksheetFunction.VLookup(Ffr.Offset(0, -9), ConsWS.Range("A:D"), 2, 0)
With ffr
.AutoFill Destination:=Range(Cells(ffr.Row, 11), Cells(Lastrow, 11)), Type:=xlFillDefault
End With
End Sub
I have two Excel workbooks.
First Workbook has two sheets: "Sales" and "Lookup".
Second Workbook has one sheet: "ID"
From the first workbook (Sales), I have to read column 'B' values, search it in column A of "Lookup" sheet and get name from column B.
After fetching ID, I have to write to column E of "ID" workbook.
I tried the first part, but it is not iterating through the cells of Sales and not picking value from "Lookup".
Sub btnExport_Click()
Dim rng As Range
Dim ws1, ws2 As Worksheet
Dim MyStringVar1 As String
Set ws1 = ThisWorkbook.Sheets("Lookup")
Set ws2 = ThisWorkbook.Sheets("Sales")
Set rng = ws2.Range("B2")
With ws2
On Error Resume Next 'add this because if value is not found, vlookup fails
MyStringVar1 = Application.WorksheetFunction.VLookup(Left(rng, 6), ws1.Range("A2:C65536").Value, 2, False)
On Error GoTo 0
If MyStringVar1 = "" Then MsgBox "Item not found" Else MsgBox MyStringVar1
End With
End Sub
*** Edited ***
Code fixed. It is now reading from first cell of Sales but not iterating. Also, while iterating and fetching from Lookup, it has to write to another workbook. This I am not able to fix.
There are two changes that you should make to start. First, try not to reference ActiveSheet (as mentioned in the comments). If the macro is run while a different sheet is selected, then it will mess things up. Store the appropriate worksheet in a variable, such as:
Dim ws As Worksheet
Set ws = Sheets("Sales")
The other item that stands out is in your loop, you are using the .Cells off of the rng object. In your case, you set rng to be the used range in Column B. Let's assume that's cells B2:B10. When you then say rng.Cells(i, 2), if actually offset to the second column of the range, which starts with Column B. You end up using column C.
Instead, try something like
Sub btnExport_Click()
Dim rng As Range
Dim i As Long
Dim ws As Worksheet
Set ws = Sheets("sales")
With ws
Set rng = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For i = 2 To rng.Rows.Count
.Cells(i, 2) = Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets("Lookup").Range("A:B"), 2, False)
MsgBox (.Cells(i, 2))
Next
End With
End Sub
I have a sheet named Inventory which has a list of sample numbers. This list grows automatically, so I have to include the whole column. It looks something like this:
I have another sheet named Inventory Count in which I want to count the unique sample numbers.
For this data, the inventory count should look something like this:
I tried doing this with advanced filter but it doesn't allow me to have 2 separate sheets which is crucial in my case.
Please help me with any formula or VBA code. Thanks in advance
Reference link
You can define name for the Column B in "Inventory" sheet like InventoryRecords
InventoryRecords = =OFFSET(Inventory!$B$1,,,COUNTA(Inventory!$B:$B),1)
In "inventory Count" Sheet, enter formula in A2
=IFERROR(INDEX(InventoryRecords,MATCH(0,INDEX(COUNTIF($A$1:A1,InventoryRecords),0,0),0)),"")
Copy it down until you get blanks and additional say 100 rows. I would copy for number of rows equivalent to the number of relevant inventory items in the inventory master.
In column B enter countif formula.
Ron Rosenfeld's suggestion in comments to the question to select unique items using advance filter, you can also record a macro. It is more efficient than the formula above which will keep calculating every time.
In "Inventory" Sheet
Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Dim SourceSh As Worksheet, DestSh As Worksheet
Set SourceSh = Worksheets("Inventory"): Set DestSh = Worksheets("Inventory Count")
Dim FilterRng As Range, UniqueRng As Range, DestRng As Range, Cl As Range
Set FilterRng = SourceSh.Range("B1:B" & Range("B" & SourceSh.Rows.Count).End(xlUp).Row)
FilterRng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set UniqueRng = FilterRng.SpecialCells(xlCellTypeVisible)
Set DestRng = DestSh.Range("A1")
UniqueRng.Copy DestRng
Application.CutCopyMode = False
Set DestRng = DestSh.Range("A2:A" & UniqueRng.Cells.Count)
For Each Cl In DestRng
Cl.Offset(0, 1) = WorksheetFunction.CountIf(FilterRng, Cl)
Next
FilterRng.AdvancedFilter Action:=xlFilterInPlace, Unique:=False
End If
Application.DisplayAlerts = True
End Sub
I want to look through a table in a sheet. Find each cell with "Yes" in it, when one is found. Paste a Yes to A1, when another is found A2, etc...
I was trying to modify this code to search all cells instead of just Row A
Following code should give you the headstart
Sub Text_search()
Dim Myrange As Range
Set Myrange = ActiveSheet.UsedRange
For Each cell In Myrange
If InStr(1, cell.Value, "YES") > 0 Then
'do something
Else
'do something else
End If
Next
End Sub
Further to #isomericharsh's answer, if it's a table you're looking through, that simplifies defining the range; just use DataBodyRange.
If the table 'Table1' is on 'Sheet1' and the results are to be posted on 'Sheet2' then I'd do as follows:
Sub Search_for_Yes()
Dim YesAmt As Long ' - Amount of yes's found
YesAmt = 0 'to start with
Dim ws1 As Worksheet
Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")
'It's always safer to use specific references rather than ActiveSheet
For Each cell In ws1.ListObjects("Table1").DataBodyRange 'The data in the table excluding headings and totals
If cell.Value = "YES" Then 'might need to add wildcards to this if you want to include cells that contain yes as part of larger text string. Also note that it's case-specific.
ws2.Cells(1 + YesAmt, 1).Value = "Yes" 'so that each time a yes is found it will log it further down
YesAmt = YesAmt + 1
End If
Next
x = MsgBox(YesAmt & " values found and listed", vbOKOnly + vbInformation)
End Sub
Does that help?
I'm having the same kind of question as in this link -
Get AutoFilter sort criteria and apply on second sheet
I've gone thru the link but not able to get the required output.
I've the filtered criteria in Sheet1 (which we can change as required) on one of the column values (eg: col 10) and now based on what ever the data in column 10 which are shown based on the filter criteria, I want to filter on sheet2 with the data in sheet 1.
I have seen that many of them using with static values in ARRAY as shown but how can I autofilter dynamically changing values in the sheet1 and filtering in Sheet2. Please advise
.AutoFilter Field:=10, Criteria1:=Array("value1", "value2"), Operator:=xlFilterValues
What if you just define the array in VBA?
Dim CritArray(2) as String
CritArray(0) = Cells(1,1).Value
CritArray(1) = Cells(2,1).Value
Then just editing your line of code:
.AutoFilter Field:=10, Criteria1:=Array(CritArray(0),CritArray(1)), Operator:=xlFilterValues
I dont know how many criteria you have (or their location), but you can add/edit as such. I based this off the fact you only have 2 criteria, but it can be enlarged of course.
I think you want something like this:
Sub tgr()
Dim wsData As Worksheet
Dim wsCriteria As Worksheet
Dim arrCriteria As Variant
Set wsData = Sheets("Sheet2")
Set wsCriteria = Sheets("Sheet1")
arrCriteria = Application.Transpose(wsCriteria.Range("J4", wsCriteria.Range("J4").End(xlDown)).Value)
With wsData.UsedRange
.AutoFilter 10, arrCriteria, xlFilterValues
End With
Set wsData = Nothing
Set wsCriteria = Nothing
If IsArray(arrCriteria) Then Erase arrCriteria
End Sub