I am looking for a way to generate a Set with two given range values.
For example, in my code, I have the following :
Set myList = FindAll(columnValue, Sheet2.Range("ColumnName"))
Set advisorFound = myList.Offset(, -2)
What i would like to do is be able to FindAll with two range values such as :
Set myList = FindAll(columnValue, Sheet2.Range("ColumnName"), anotherColumnValue, Sheet2.Range("anotherColumnName"))
However, I am aware that the FindAll function is not what I am looking for since it only takes up to two parameters and the rest of the code wouldn't make sense either if I was using that (the offset wouldn't work).
My end goal would be to : get a set of rows that contain both of the range restrictions, and i would simply like to have access to a row in this set that has a minimal value in another column (compared to other rows found)
I have looked up the documentation (https://msdn.microsoft.com/en-us/library/office/ff839746.aspx) but I can't seem to find what I am looking for. Thanks in advance, I appreciate your help :)
you could use AutoFilter():
With Worksheets("Sheet2") '<--| reference your data sheet
With .Range(.Range("ColumnName"), .Range("anotherColumnName")) '<--| reference its range ranging between two named ranges
.AutoFilter Field:=.Parent.Range("ColumnName").Column - .Columns(1).Column + 1, Criteria1:=columnValue '<--| 1st filter on first named range
.AutoFilter Field:=.Parent.Range("anotherColumnName").Column - .Columns(1).Column + 1, Criteria1:=anothercolumnValue '<--| 2nd filter on 2nd named range
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filtered cell then
With Intersect(.Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow, .Columns(1).Offset(, -2)) '<--| reference cells two columns to the left of the lower column index named range filtered ones
Set myList = Intersect(.Find(what:=WorksheetFunction.min(.Cells), lookat:=xlWhole, LookIn:=xlValues).EntireRow, .Parent.UsedRange) '<-- set the row "used" range with the minimum value in the referenced cells
End With
End If
End With
.AutoFilterMode = False
End With
Related
I am pretty new to VBA and I have been fighting with creating one simple report for many days so I decided to inquire for some help. I will be really grateful for any tips you have or could point to any errors I might've made in my code.
I have the below piece of code (extracted from my loop). What I want to do is to create a list based on around 20 excel files that will have below stats:
name of the current tab inside the workbook
count of nonblanks in a column which name contains word "Difference" (always in row 7 but can be in different columns)
count from the same column but where cells are not blank AND different than 0.
For the last stat I didn't even start so you won't see it in my code but I would appreciate if you have any tips for this one too (which method best to use).
Windows("PassRate.xlsm").Activate
b = ActiveSheet.Cells(Rows.count, 2).End(xlUp).Row + 1
Cells(b, 3) = xlWorkBook.Worksheets(i).Name
xlWorkBook.Worksheets(i).Activate
Set Myrng = Range("B7:M9999").Find(What:="Difference", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False)
If Not Myrng Is Nothing Then
RowQnt = xlWorkBook.Worksheets(i).Myrng.Offset(9999, 2).Cells.SpecialCells(xlCellTypeConstants).count
End If
Windows("PassRate.xlsm").Activate
Cells(b, 4) = RowQnt
My problem is that the macro runs and works, but the result I get is the list of tab names but all counts are 0 and I cannot overcome this issue. For the line number 7 I've also tried the piece of code below which yields the same result.
RowQnt = xlWorkBook.Cells(Rows.count, Myrng).End(xlUp)
Is it possible that my problem is due to the fact that in the source files the column containing word "Difference" is sometimes two merged columns? Unfortunately, I cannot change that as these are some automatically generated files from another program.
xlWorkBook.Worksheets(i).Myrng isn't a valid Range syntax while you can simply use MyRng which you already set to a not null Range reference and already has both parent worksheet and workbook references inside it
but even Myrng.Offset(9999, 2).Cells wouldn't do since it references one cell only and not a range of cells
you need a Range(Range1, Range2) syntax, where both Range1 and Range2 are valid Range references to the first and last cell of the range you actually want to count not blank cells of
furthermore you could use WorksheetFunction.CountA() function instead of SpecialCells(xlCellTypeConstants) range, since this latter errors out if no constant cells are found in the range it's being applied to (so you'd need a check) while the former simply returns zero if no not empty cells are found
for all what above you could write the following GetRowQnt() function:
Function GetRowQnt(sht As Worksheet) As Long
Dim Myrng As Range
With sht '<--| reference passed worksheet
Set Myrng = .Rows(7).Find(What:="Difference", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False) '<--| find "Difference" in its 7th row
If Not Myrng Is Nothing Then GetRowQnt = WorksheetFunction.CountA(.Range(.Cells(8, Myrng.Column), .Cells(WorksheetFunction.Max(.Cells(.Rows.count, Myrng.Column).End(xlUp).row, 8), Myrng.Column))) '<--| count not blank cells in column where "Difference" was found from row 8 down to its last not empty cell
End With
End Function
and use it in your main code as follows:
With Windows("PassRate.xlsm").ActiveSheet '<--| reference "PassRate.xlsm" workbook active sheet (or change 'ActiveSheet' with 'Worksheetes("yourSheetName")')
For i = 1 To xlWorkbook.Worksheets.count '<--| loop through 'xlWorkbook' workbook worksheets
b = .Cells(.Rows.count, 3).End(xlUp).row + 1 '<--| get "PassRate.xlsm" workbook active sheet current first empty cell in column "C"
.Cells(b, 3) = xlWorkbook.Worksheets(i).Name
.Cells(b, 4) = GetRowQnt(xlWorkbook.Worksheets(i))
Next
End With
please note that with
b = .Cells(.Rows.count, 3).End(xlUp).row + 1
I took column "C" as the leading one to get last not empty row from, since there was no code in your post that wrote something in column "B".
But if your real code has some
.Cells(b, 2) = somedata '<--| write something in column "B" current row
then you can go back to b = .Cells(.Rows.count, 2).End(xlUp).row + 1
New to VBA, and I'm trying to create multiple ranges or arrays based on a criteria in a column, then place those in a separate worksheet. The issue is that this code has to work for several different data sets. So one data sat will look something like
this, but with far more data points ( around 10,000 for each data set).
So what I'm trying to do is, for each group of 1's in the state column, create a range/array, then move the corresponding time and data in a new worksheet. So for the example I have, there would be 3 new worksheets, with the first new worksheet containing range("A2:B5"), the second one containing range("A10:B12"). With each data set, the state column changes and the number of new worksheets can also vary.
I have looked through this site, and the closest I have found to my needs is Creating Dynamic Range based on cell value, but it has a known number of ranges. I quite honestly have no idea how to accomplish what I need. I've been trying to make a while loop inside of a if then loop inside of a for each loop, but can't make it work.
Any help would be greatly appreciated! Been banging my head for hours now.
this should help you:
Option Explicit
Sub main()
Dim area As Range
With Sheets("myDataSheet") '<--| reference your sheet (change "myDataSheet") to your actual sheet name
With .Range("C1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:C range form row 1 down to last column A not empty row
.AutoFilter Field:=3, Criteria1:="1" '<--| filter referenced range on its 3rd column (i.e. "State") with 1
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filterd cells other than header
For Each area In .Resize(.Rows.Count - 1, 2).Offset(1).SpecialCells(xlCellTypeVisible).Areas '<--| loop through filtered range (skipping header) 'Areas'
area.Copy Sheets.Add(Sheets(Sheets.Count)).Range("A1") '<--| copy current 'Area' into new sheet
Next area
End If
End With
.AutoFilterMode = False
End With
End Sub
Working on Microsoft Visual Basic Application Edition 7.1 in Excel 2013
Data are on columns from A to D, rows' number varies from time to time. I would like to delete all rows for which column B's value doesn't start with LCR (and also I would like not to bore with a for...next loop).
Something like:
Columns("B:B").AutoFilter Field:=1, Criteria1:="<>LCR*"
Selection.Delete
Unfortunately, this code deletes heading row (row number 1) and I don't want.
I tried to store row number 1 elsewhere in a range variable, but it doesn't work (run-time error '424')
Set r1 = Range("A1:D1")
r1.Copy
Columns("B:B").AutoFilter Field:=1, Criteria1:="<>LCR*"
Selection.Delete
With Range("A1:D1")
.Insert Shift:=xlDown
.Select
.Value = r1.Value
End With
How can I tell the filter to start from row number two (or how can I correctly store content of row number one so to paste it after deletion by filter)?
Thanks in advance for your help
Define your range for deleting as Range(Cells(2,2),Cells(ActiveSheet.UsedRange.Rows.Count,2)) (To replace the Selection call). This will delete everything except for the first cell in the column
Edit to avoid excel prompt: Range(Cells(2,2),Cells(ActiveSheet.UsedRange.Rows.Count,2)).EntireRow
in a more complete way you could go like this
Sub main()
With Worksheets("MyWantedSheet") '<--| always specify full worksheet reference (change "MyWantedSheet" with your actual sheet name)
With .Columns("B:B") '.Resize(.Cells(.Rows.Count, "B").End(xlUp).Row) '<--| refer to wanted column range down to its last non empty cell
.AutoFilter '<--| remove possible preeeding autofilter filtering
.AutoFilter Field:=1, Criteria1:="<>LCR*" '<--| apply current filtering
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if there are visible cells other than the "header" one
.Resize(.Parent.Cells(.Parent.Rows.Count, "B").End(xlUp).Row - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '<--|delete visible rows other than the first ("headers") one
End If
End With
.AutoFilterMode = False '<--| remove drop-down arrows
End With
End Sub
I've been banging my head on this one for a while.
I have a big macro I made doing a number of operations on a file but got stuck on doing a series of filtering and vlookups.
Here is a portion of what I got. I added comments to make it clearer.
'FILTER ALL 3P VALUES IN ONE COLUMN AND ADD A VALUE IN ALL RESPECTIVE CELLS IN OTHER COLUMN
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
.AutoFilter Field:=22, Criteria1:="*3P*"
.Offset(1).Range("AU1:AU" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
'HERE I SELECT ALL VISIBLE FILTERED CELLS BY COUNTING IN ROW A BECAUSE THESE CELLS ARENT BLANK
.Selection.Value = "3P PROGRAM"
.AutoFilter
End With
'NOW I WANT TO FILTER ROW FOR BLANKS AND THEN FILL THIS RANGE WITH A FORMULA
'HERE IS THE PROBLEM
With ActiveSheet.UsedRange
.AutoFilter Field:=47, Criteria1:="="
.Offset(1).Range("AU1:AU" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
.Selection.FormulaR1C1 = "=VLOOKUP(RC[-38],'[WeeklyData.xlsx]Sheet1'!C8:C16,9,FALSE)"
.AutoFilter
End With
Problem is at the vlookup step. I want that range of visible filtered blank cells to get the value gotten by vlookup. Every cell should take a cell 38 columns to the left as a vlookup reference.
I cant find a way to make formula work. I would like to:
-insert vlookup to that filtered range,
-remove filter (Autofilter)
-Select calculated column with offset of 1 for headers and paste as special values
- carry on to do this process 5, 6 more times for blank or invalid entries in other columns.
Is there a way to do this?
Any help is appreciated
I prefer the Range.CurrentRegion property over the Worksheet.UsedRange property. It refers to the 'data island' created at the origin point (in this case, A1).
With ActiveSheet
If .AutoFilterMode Then AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
'Set the filter
.AutoFilter Field:=22, Criteria1:="*3P*"
'Shift off the header row
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
'check if there are any visible cells
If CBool(Application.Subtotal(103, .Cells)) Then
'Put 3P PROGRAM into the visible cells in column AU
Intersect(.Columns(47), .SpecialCells(xlCellTypeVisible)) = "3P PROGRAM"
End If
End With
'remove the filter
.AutoFilter Field:=22
'set the formula on column AU blank cells
Intersect(.Columns(47), .SpecialCells(xlCellTypeBlanks)).FormulaR1C1 = _
"=VLOOKUP(RC[-38], '[WeeklyData.xlsx]Sheet1'!C8:C16, 9, FALSE)"
'revert column AU within the .CurrentRegion to the values returned by the formulas
.columns(47).cells = .columns(47).cells.value
End With
End With
The second filter is replaced by using the Range.SpecialCells method with the xlCellTypeBlanks property. The Intersect method isolates the cell range reference to the blank cells within column AU. You may want to make a check for blank cells before running that operation.
I have a table (Table 1) with a whole bunch of well data (versions, MD, HD, etc.) and I want to create another table (Table 2) that will only show the data for the well I am interested in.
I have it set up where you select the well using a drop down list. Then I want Table 2 to be populated with four values for each of the iterations that show up in Table 1....
I tried using vlookup but was having issues when a well had multiple versions. And I also tried using an advanced filter.
Screenshot of the spreadsheet
Let's solve this using a helper column. First, assume column A will be used to the left of your table, to show the row number which each one of these is found in.
A5 would have the following formula:
=MATCH($C$1,K:K,0)
This shows us the row number that Well1 is first matched at. Then A6 and copied down would have the formula:
=A5+MATCH(B6,OFFSET(K1,A5,0,COUNT(M:M),1),0)
This uses OFFSET to create a new range, starting at the cell immediately below the previous match for Well1, and then uses MATCH to find what row that occurs.
So now, column A will always show the row number to pull data from. The rest is simply using the INDEX function to pull from your desired columns. For example, the data in column C pulls the iteration from column L, and can be pulled through formula like so, in cell C5 and copied to the right / down:
=INDEX(L:L,$A5)
If your data is appropriately normalized, you might be better off with a Pivot Table. This would give you the option of filtering by Well ID.
To use a Advanced filter you will need to create a worksheet event. Place this in the code for the sheet on which you want the data.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2")) Is Nothing Then
Dim dataRng As Range
Dim critRng As Range
Dim CpyToRng As Range
Dim cpytoarr() As Variant
With Worksheets("Sheet1")
Set dataRng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown).End(xlToRight))
End With
With Me
.Range("CC1") = .Cells(1, 1).Value
.Range("CC2") = "'=" & .Cells(2, 1).Value
Set critRng = .Range("CC1:CC2")
Set CpyToRng = .Range(.Cells(6, 1), .Cells(6, 1).End(xlToRight))
End With
Debug.Print dataRng.Address
Debug.Print critRng.Address
Debug.Print CpyToRng.Address
dataRng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=critRng, CopyToRange:=CpyToRng, _
Unique:=False
critRng.ClearContents
End If
End Sub
How this works. This assumes the data is on Sheet1 and starts in "A1" with no blanks in column A or the last row:
On Sheet2 set it up like this:
It is important that the header rows on sheet2 are name identical to the headers on sheet1.
Now every time that the value changes in A2 on sheet 2, your drop down, the requisite data will appear below row 6.