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
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 am looking for converting my Yes & No matrix to a separate sheet tabs in workbook of excel with help of Macro in VBA.
So I have B1 to Z1 columns named with equipment and column A2 to A50 named with tests. The area B2 to Z50 is filled with Y and N based on the test and the requirement of equipment.
What I am looking is if there is any way I can use Macro to do split the data in sheets with Equipment names and each sheet will contain name of only those tests which are marked Y in the matrix.
Example Matrix
I am new to VBA, had done couple of tries by looking it resources available on intermate but no luck so far. Looking fwd for you help!
Try this code:
Option Explicit
Sub splitEq()
Dim ws As Worksheet, dataArea As Range, rng As Range, cl As Range
Const DATA_SHEET_NAME = "DataSheet" ' DataSheet into Worksheets("DataSheet") with the name of your own worksheet with data
Const ANCHOR = "H16" 'cell address within data range
Application.ScreenUpdating = False ' speed up script working
With ThisWorkbook.Worksheets(DATA_SHEET_NAME)
Set dataArea = .Range(ANCHOR).CurrentRegion
For Each cl In Intersect(dataArea(1).EntireRow, .UsedRange, .UsedRange.Offset(0, 1)) ' skip rows names column
dataArea.AutoFilter ' set initial filter or reset previous filter
dataArea.AutoFilter Field:=cl.Column - dataArea(1).Column + 1, Criteria1:="Y"
' select only visible cells after filter apply and get rows names at rows where these cells are is
Set rng = Intersect( _
Intersect(cl.EntireColumn, .UsedRange) _
.SpecialCells(xlCellTypeVisible) _
.EntireRow, .Columns(dataArea(1).Column))
If rng.Cells.Count > 1 Then ' rng contains not only header
Set ws = ThisWorkbook.Worksheets.Add
ws.Move After:=ThisWorkbook.Worksheets( _
ThisWorkbook.Worksheets.Count) ' move the ws to the end
ws.Name = cl ' set the ws name
rng.Copy ws.Range("A1")
End If
Next
.AutoFilterMode = False ' switch off the filter
End With
Application.ScreenUpdating = 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?
Objective:
There is data stored in sheet "Risk Partner Data" in a table called "RPdata". In the table there is a column called "AICOW" which bears two results, yes or no.
In a second sheet called "Calc Data", I would like to build a macro that starts at after the last filled cell (but ignores a cell that is empty in between data), and for every row that has a "yes" result in AICOW, it copies into row A the corresponding [RPdata#Parish].
The result I am after is that at the end of Column A, the macro will add the parish name for only the parishes with AICOW (yes) and not any others.
I have attempted but my code is not working and I'm not sure its even right
Set Source = Sheet("Risk Partner Data")
Set c.FormulaR1C1 = _
"=if("RPdata[#[AICOW]]"=""Yes"","Yes",0)
Set Target = [RPdata#Parish]
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.For each c in source.range(RPdata[#AICOW])
If c = "yes" Then
Source.Rows(c.Row).Copy Target.Rows(a)
a = a + 1
End If
End c
Instead of looping, consider filtering and copying the visible cells from the "Parish" column in one go.
Also, consider using the built-in ListObject and ListColumn objects.
Sub CopyParishes()
Dim riskPartnerDataTbl As ListObject
Dim parishCol As ListColumn, AICOWcol As ListColumn
Dim copyRng As Range
Set riskPartnerDataTbl = ThisWorkbook.Worksheets("Risk Partner Data").ListObjects("RPdata")
With riskPartnerDataTbl
Set parishCol = .ListColumns("Parish")
Set AICOWcol = .ListColumns("AICOW")
.Range.AutoFilter Field:=AICOWcol.Index, Criteria1:="Yes"
End With
On Error Resume Next
Set copyRng = parishCol.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not copyRng Is Nothing Then
copyRng.Copy
With ThisWorkbook.Worksheets("Calc Data")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End If
riskPartnerDataTbl.Range.AutoFilter Field:=AICOWcol.Index
End Sub
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