I am looking for a method that will select only cells which contain data between TWO columns. I can't wrap my head around the logic I need to accomplish this.
I am thinking that this is my best bet, but am open to other suggestions.
Sheet1.Columns("A3:B1000").SpecialCells(xlCellTypeConstants, 23).Select
With this code I can select the range that contains a value, however it doesn't work simultaneously between the two columns. If column A has data but column B does not, it will still select column A.
Below is what I am looking to do.
The following code will do what you expect by filtering any blank cells and then selecting all visible cells, for my example, I used columns A & B, amend this as required.
NOTE: I agree with comments from CallumDA, you would usually want to avoid selecting anything, but yet the example code below will show you how to add that given range to a variable, should you want to do something with it, rather than just select it.
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
Lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim rng As Range
ws.Range("$A$1:$B$" & Lastrow).AutoFilter Field:=1, Criteria1:="<>"
ws.Range("$A$1:$B$" & Lastrow).AutoFilter Field:=2, Criteria1:="<>"
Set rng = ws.Range("A2:B" & Lastrow).SpecialCells(xlCellTypeVisible)
ws.Range("$A$1:$B$" & Lastrow).AutoFilter
rng.Select
End Sub
Related
so I am trying to copy unique values from a column after applying several filters to it. For one of the filter I cant filter by exact string because the column is like this:
I want the values which have "U" in 8th position from right and want to ignore the ones which have "O" in the same place.
So for example, in the image: 'S20-0260-TA-002_W06_05C_AMBRH_U-404728' should be present but 'S20-0260-TA-001_W06_30C_75RH_O-404713' shouldn't be.
I know how to check a character from right, from the RIGHT function but I am struggling to apply it in a filter with if condition.
This is my relevant code so far with other filters:
Dim uniquesArray As Variant
Dim uniqueCond As Variant
Dim lastCondRow As Long
Dim lastRow As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("New Data")
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set DR = ThisWorkbook.Sheets("Test")
With ThisWorkbook.Sheets("Test")
'Find unique Condition
Worksheets("New Data").Range("$B$1:$X$9999").AutoFilter Field:=10, Criteria1:= _
"Assay by HPLC"
Worksheets("New Data").Range("$B$1:$X$9999").AutoFilter Field:=15, Criteria1:= _
"(Average)"
ws.Range("I1:I9999").SpecialCells(xlCellTypeVisible).Copy
.Cells(1, 27).PasteSpecial
.Columns("AA:AA").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("AB1"), Unique:=True
lastCondRow = .Cells(.Rows.Count, "AB").End(xlUp).Row
uniqueCond = .Range("AB2:AB" & lastCondRow)
.Columns("AB").ClearContents
.Columns("AA").ClearContents
End With
I want to apply this filter as well below the 2 auto-filters under the find unique comment. The column number is F, please help
Alternative Option
Offering this alternative, mainly to demonstrate how to apply multiple filters, and one method of applying criteria using wildcards to find exact location of specific characters. This uses a 3 step approach:
• Apply all the filters
• Copy the Data
• Remove duplicates – leaving unique values only
All the action takes place on the “New Data” sheet, and you can change this and the various columns referred to as you wish. Provided for demonstration purposes only.
Option Explicit
Sub testCopyUnique()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("New Data")
Application.ScreenUpdating = False
'Apply all filters and copy the visible cells
With ws.Cells(1, 2).CurrentRegion
.AutoFilter 10, "Assay by HPLC"
.AutoFilter 15, "(Average)"
.AutoFilter 5, "*U???????" '<~~ ”*” = any number of characters, “?” = one character
ws.Range("I:I").SpecialCells(xlCellTypeVisible).Copy ws.Range("AA1")
.AutoFilter
End With
'Remove the duplicates - leaving unique comments only
ws.Range("AA1:AA" & ws.Range("AA" & Rows.Count).End(xlUp).Row).RemoveDuplicates _
Columns:=1, Header:=xlYes
Application.ScreenUpdating = True
End Sub
I'm very new to VBA and was hoping to get come clarification on a project. I've tried solving it with formulas but I need to still be able to enter information into cells and not have them filled with a lookup formula.
How I'm looking for it to preform is that if an object requires it to be shipped then the serial numbers and identifiers are copied and pasted in another table in the next blank row automatically.
Information divided into two tables
What I thought I needed was a segment in VBA that went like this:
Sub CopyCat()
If Range("J2") Like "*yes*" then
Range("G2:I2").copy
Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues
If Range("J3") Like "*yes*" then
Range("G3:I3").copy
Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues
End If
End If
End Sub
It does exactly what I ask it to do when it is only the first statement, when I add the second one to check if the next row satisfies the conditions and it does, then it places it in the same resulting cell as the first statement. If both are true I need them both to be displayed in table 1.
I'd love to take this as a learning opportunity so any information or direction you can point me in would be great! Thank you so much in advance!
I think Range("A2:A10").end(xlup) is equivalent to Range("A2").end(xlup) so will not change, but you don't want the A2 reference, you want to work up from the bottom. You will hit problems if you are going beyond A9. (Plus not sure you want nested Ifs.)
If Range("J2") Like "*yes*" Then
Range("G2:I2").Copy
Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
If Range("J3") Like "*yes*" Then
Range("G3:I3").Copy
Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
Or to add a loop and circumvent the copy/paste you could use something like this:
Sub CopyCat()
Dim r As Long
For r = 2 To Range("J" & Rows.Count).End(xlUp).Row
If Range("J" & r) Like "*yes*" Then
Range("A10").End(xlUp).Offset(1).Resize(, 3).Value = Range("G" & r).Resize(, 3).Value
End If
Next r
End Sub
You can also do this without VBA.
In A2, you can use this formula entered as an array formula with CTRL+SHIFT+ENTER:
=INDEX($G$2:$G$4,SMALL(IF($J$2:$J$4="yes",ROW($J$2:$J$4)-ROW($J$2)+1),ROWS(J$2:J2)))
And in B2, you can put this and drag down/over from B2:D3:
=INDEX(H$2:H$4,MATCH($A2,$G$2:$G$4,0))
Finally, to hide the errors that show when there are no more matches, you can simply wrap both above formulas in IFERROR([formula above],"").
With autofilter
Sub copyRange()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim lastRow As Long
Dim filterRange As Range
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet2") 'change to sheet name containing delivery info
With wsSource
lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
Set filterRange = .Range("G1:K" & lastRow)
Dim copyRange As Range
Set copyRange = .Range("G2:K" & lastRow)
End With
Dim lastRowTarget As Long, nextTargetRow As Long
With filterRange
.AutoFilter
.AutoFilter Field:=4, Criteria1:="yes" 'change field to whichever is the field in the range containing your company names
lastRowTarget = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
nextRowTarget = lastRowTarget + 1
Union(wsSource.Range("G2:I" & lastRow).SpecialCells(xlCellTypeVisible), wsSource.Range("K2:K" & lastRow).SpecialCells(xlCellTypeVisible)).Copy wsSource.Range("A" & nextRowTarget)
.AutoFilter
End With
End Sub
I'm using the alteration of the code from Scott Craner (which works perfectly). However, now I would like VBA to match criteria not only from one column but from 2 columns and then copy/paste as formulas to the next sheet.
Sub TransferRows()
Dim lLRow As Long
With Sheets("Sheet1")
lLRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("B:B").AutoFilter Field:=1, Criteria1:="Cat"
.Range("B2:B" & lLRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlFormulas
.AutoFilterMode = False
End With
End Sub
Criteria1 in column "B" is "Cat", I need to add another Criteria2 ("dog") from column "C". So whenever I have "Cat" in "B" and "Dog" in "C" the entire rows are copied to Sheet2. PS. Bear in mind that I have various types of data in columns "B" and "C" so filters are imperative (also since there are 10's of thousands of rows I can't use the loop as it takes too long). Thus I would welcome advice on how to add another criteria to the aforementioned code.
Thanks
West
Try the code below (see comments inside the code):
Option Explicit
Sub TransferRows()
Dim lLRow As Long
With Sheets("Sheet1")
lLRow = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range("B1:C" & lLRow)
.AutoFilter Field:=1, Criteria1:="Cat"
.AutoFilter Field:=2, Criteria1:="dog"
End With
.Range("B2:C" & lLRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
' rest of your code goes here
End With
End Sub
I have a large table of data and my goal is to advanced filter that table by Column B from sheet 2.
I defined my variables as ws0 (where the data I am filtering is) is my Sheet1 and ws02 is my Sheet2 (where the filter criteria is). It's just not working, I can get it to work if i specify the exact ranges but I want this to find the last row on sheet two as that range of data will change. Here is my code: I would also love to be able to find the last from from ws0 as well..but one step at a time :)
Dim LastRow As Long
With ws02
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
ws0.Range("A1:I3000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
ws02.Range("B1").LastRow, Unique:=False
End Sub
If anyone can help I'd greatly appreciate it!!
Here is Sheet 1
Here is Sheet 2
Try changing
CriteriaRange:= _
ws02.Range("B1").LastRow
To
CriteriaRange:= _
ws02.Range("B2:B" & LastRow)
You are attempting to use LastRow as a property or a method of the Range object, but no such property or method exists.
This will use the criteria from cell B2 to the last row in column B.
If I apply auto-filter on my input sheet and then run VBA code, the code does not care about the auto-filter.
But, sometimes running VBA code on an auto-filtered sheet messes up the results of the program.
So, my question is; does VBA care about auto-filter?
For example:
Sub check()
Dim rng as range
Set rng = Sheets("input").Range("A1")
row = 0
Do until rng.offset(row,0) = ""
row = row + 1
Loop
End Sub
In the above code, VBA does not care if auto-filter is applied on column A, and it still iterates through all the rows. However, if I try to write on cells where there is auto-filter, it messes up.
VBA Doesn't care about Autofilter unless you "tell it" to or are trying to perform actions which can get affected by the Autofilter.
Your above code will work with any sheet and not just with "Input" Sheet.
Here is another method where it works beautifully (in fact I use it all the time)
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
'~~> Filter, offset(to exclude headers) and delete visible rows
With rRange
.AutoFilter Field:=1, Criteria1:=strCriteria
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
And here is a scenario when it doesn't work.
Charts don't show data which were filtered by Autofilter. But then the chart also doesn't show data which is present in hidden rows. This applies to both VBA and Non VBA methods of showing data in the chart.
but if i try to write on particular cells where autofiler is applied it messes up.
It depends on how and where you are writing it.
This works very nicely. Note in the below code, row has been filtered and is not visible. However, we can still write to it.
Option Explicit
Sub Sample()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1")
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
rng.Offset(1, 0).Value = "Sidd"
End Sub
Now let's take another case. This will not work. Let's say you have a range A2 to A10 (A1 has Header) which has various values ranging from 1 to 3. Now you want to replace all the values in A2:A10 by say 1000. This code will not give you the expected output if there is an Autofilter. It will not change all the cells.
Option Explicit
Sub Sample()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1:A10")
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
rng.Value = "1000"
End Sub
Why does it ignore the cells which have "1" (i.e the rows which were filtered out) and writes to rest of the rows? In fact it messes up with the header as well???
It's quite simple. The idea of having Autofilter is get the relevant data as per what our requirement is (at the moment it is data which is <> 1). When you write to the range rng then it will write to all cells which are visible (including the cell which has header) in that range.
So what do we do in this case?
You have two options
1) Remove the Autofilter - Do the necessary actions - Put the filter back
Sub Sample()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1:A10")
'~~> Put Filter
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
'~~> Remove Filter
ActiveSheet.AutoFilterMode = False
'~~> Write value to the cells (See how we ignore the header)
Sheets("Sheet1").Range("A2:A10").Value = "1000"
'~~> Put Filter back
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
End Sub
2) Loop the range as you did in your question
Sub Sample()
Dim rng As Range, cl As Range
Set rng = Sheets("Sheet2").Range("A1:A10")
rng.AutoFilter Field:=1, Criteria1:="<>1", Operator:=xlAnd
For Each cl In rng
'~~> Ignoring the Header
If cl.Row <> 1 then _
cl.Value = "1000"
Next
End Sub
When you run the above code, it writes to all the cells except the header.
I would recommend you to read Excel's inbuilt help to understand how AutoFilters actually work. That would help you understand them which will in turn help you handle sheets which have Autofilter turned on.
HTH