currently my excel data consists of specific words and #N/A, words are like "build One" "proj ex".. I have prepared a code in which it only deletes one condition but I want it for many words. below is my code. Any help is welcome. Thanks.
Sub del()
Dim rng1 As Range
Set rng1 = Range([B2], Cells(Rows.Count, "B").End(xlUp))
ActiveSheet.AutoFilterMode = False
With rng1
.AutoFilter Field:=1, Criteria:=("#N/A")
.Delete xlUp
End With
End Sub
Use a variant array as a constructor for your word list.
Sub del()
Dim rng1 As Range, vDELs As Variant
vDELs = Array("#N/A", "proj ex", "build One")
Set rng1 = Range([B2], Cells(Rows.Count, "B").End(xlUp))
ActiveSheet.AutoFilterMode = False
With rng1
.AutoFilter Field:=1, Criteria1:=(vDELs), Operator:=xlFilterValues
With .Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then _
.EntireRow.Delete
End With
.AutoFilter
End With
End Sub
Good catch on bracketing the array in Criteria1:=(vDELs). That is important. Also a good idea to check if you have rows to delete before committing to the operation.
you could try something like:
sFormula = "=IF(OR(ISERROR(B:B),B:B=""proj ex"", B:B=""build One""),NA(),"""")"
Set rng1 = Range("A2:A" & Cells(Rows.Count, "B").End(xlUp).Row)
rng1.Formula = sFormula
' Now use SpecialCells to remove the rows:
rng1.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete shift:=xlUp
more on this type of technique at SO: How to delete multiple rows in Excel without a loop and Ron de Bruin Excel VBA Top Banana: Special Cells limit bug
Related
Is the syntax limit really just two? So I have to either use an array or just repeat the block of code? The error is at Criteria3:= in my .AutoFilter Field - Compile error: Named argument not found. I'm just surprised that it's limited to two. What is the reason behind this?
Sub CleanData()
'B b b b boilerplate!
Dim sht As Worksheet, lastrow As Long, myrange As Range
'Set references up-front
Set sht = ThisWorkbook.Worksheets("MySheet")
'Identify the last row and use that info to set up the Range
With sht
lastrow = .Cells(sht.Rows.Count, "A").End(xlUp).Row
Set myrange = .Range("A2:AS" & lastrow)
End With
Application.DisplayAlerts = False
With myrange
'Apply the Autofilter method to the first column of
.AutoFilter Field:=26, _
Criteria1:="Operator Error", _
Operator:=xlOr, _
Criteria2:="Duplicate", _
Operator:=xlOr, _
Criteria3:="Training/Test"
'ERROR HERE
'Delete the visible rows while keeping the header
On Error Resume Next
.Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
On Error GoTo 0
End With
Application.DisplayAlerts = True
'Turn off the AutoFilter
With sht
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
End With
End Sub
Criteria3 is not a valid parameter., but to get around this, you can use an array:
(Filtering on multiple states)
Criteria1:=Array("IL", "IN", "MI", "OH", "WV"), Operator:=xlFilterValues
To sum up, I try to copy some filtered data from a workbook A to a workbook B keeping the formatting of the workbook B.
Here is the relevant part of my code:
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
.SpecialCells(xlCellTypeVisible).Copy
End With
End With
destinationSheet.Range("B4").PasteSpecial xlPasteValues
The paste special is not working and this is the formatting of the workbook A that is used.
Solved:
The problem was that you can't use PasteSpecial in a discontinuous range.
So I went with the solution of Siddharth Rout to go through all the areas of the filtered range:
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
'~~> Loop through each area
For Each area In filteredRange.Areas
With destinationSheet
'~~> Find Next available row
lRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
area.Copy
destinationSheet.Range("B" & lRow).PasteSpecial xlPasteValues
End With
Next area
End With
End With
What #Jeeped has mentioned is very true that you cannot used Paste Special on a filtered range if they are Non Contiguous. However there is a way to achieve what you want :)
You have to loop through each area of the filtered range and then use Paste Special as shown below
Sub Sample()
Dim ws As Worksheet
Dim lastRowOriginSheet As Long
Dim filteredRange As Range, a As Range
Dim projectNumber As Long
'~~> I have set these for testing. Change as applicable
projectNumber = 1
Set ws = Sheet1
Set destinationSheet = Sheet2
lastRowOriginSheet = 16
With ws
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
'~~> Loop through each area
For Each a In filteredRange.Areas
With destinationSheet
'~~> Find Next available row
lRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
a.Copy
destinationSheet.Range("B" & lRow).PasteSpecial xlPasteValues
End With
Next a
End With
End With
End Sub
In Action
PasteSpecial does not work on a discontiguous range. If you have one hidden row in among visible rows then you have a discontiguous range. However, due to the nature of a discontiguous range, a straight copy and paste will paste formats and the values from formulas; i.e. it cannot determine how to shift the cell ranges in formulas so it just pastes values.
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
'you should probably check to ensure you have visible cells before trying to copy them
.SpecialCells(xlCellTypeVisible).Copy destination:=destinationSheet.Range("B4")
End With
End With
Try this. Instead of doing PasteSpecial, since you just need values, you can set the ranges equal to eachother.
Dim copyRng As Range
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set copyRng = .SpecialCells(xlCellTypeVisible)
End With
End With
' destinationSheet.Range("B4").Value = copyRng.Value
With destinationSheet
.Range(.Cells(4, 2), .Cells(4 + copyRng.Rows.Count - 1, 2 + copyRng.Columns.Count - 1)).Value = copyRng.Value
End With
(this is assuming your worksheet and lastRow and projectNumber are all declared properly and working).
Edited because if you just do Range("B4").Value = Range("A1:Z100").Value, it's only going to put the first value in your copied range in the cell. You need to expand the destination range to be the size of the copy range.
I have 15 columns of data, with rows ranging from 400 - 1000, and I have applied filters, I am keen to only copy visible cells, for column D and J, onto a different sheet, but paste special values through transpose into range D6.
I have used this below method, but it is only copying two visible rows, and not every single row according to the code, like it has done for me in the past for other sheets I have run after amending it. The problem could be I am running three or four process in one macro.
I would be keen to know how I can amend this code so it copies column d and column j visible cells, excluding headers into a different sheet
So where do I stand with the code, it runs and applies the filters, but fails to copy all the rows for this particular part of the macro and secondly, I would be keen to know how to amend it so it only copies the Column D and J as the above excluding headers and only copies visible cells for to paste special values through transpose.
Set rngToCopy = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
Report.Range("D6").PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rngToCopy As Range, rRange As Range
Set ws = Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rRange = .Range("A1:A" & lRow)
'~~> Remove any filters
.AutoFilterMode = False
With rRange 'Filter, offset(to exclude headers) and copy visible rows
.AutoFilter Field:=1, Criteria1:="<>"
Set rngToCopy = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With
'~~> Remove any filters
.AutoFilterMode = False
rngToCopy.Copy
'
'~~> Rest of the Code
'
End With
End Sub
I added thomas code to sub piece to see if the autofilter works and getting error 91
Sub Filter()
Dim Sheetx As Worksheet
Dim rngToCopy As Range, rRange As Range
With Sheetx
Set rRange = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
With rRange
.AutoFilter Field:=11, Criteria1:="30"
.AutoFilter Field:=4, Criteria1:="1"
.AutoFilter Field:=2, Criteria1:="=*1", _
Operator:=xlAnd
With .SpecialCells(xlCellTypeVisible)
Set rngToCopy = Union(.Offset(0, 3), .Offset(0, 9))
End With
rngToCopy.Copy
End With
End With
End Sub
We can use Union and Range.Offset to join the cells together define the range.
MSDN: Application.Union Method (Excel)
Returns the union of two or more ranges.
Sub Sample()
Dim lRow As Long
Dim rngToCopy As Range, rRange As Range
With Sheets("Sheet1")
With .Range("A1").CurrentRegion
.AutoFilter Field:=11, Criteria1:="=30"
.AutoFilter Field:=4, Criteria1:="=1"
.AutoFilter Field:=2, Criteria1:="=1", _
Operator:=xlAnd
On Error Resume Next
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rngToCopy Is Nothing Then
MsgBox "SpecialCells: No Data", vbInformation, "Action Cancelled"
Exit Sub
End If
Set rngToCopy = Intersect(rngToCopy, .Range("B:B,H:H"))
If rngToCopy Is Nothing Then
MsgBox "Intersect: No Data", vbInformation, "Action Cancelled"
Exit Sub
End If
End With
End With
rngToCopy.Copy
Sheets("Sheet2").Range("C6").PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
I am making a small program. On main sheet, there are two combo boxes.
What I am trying to do, if I select value from each combo box, it will filter the data. But I am facing a small problem. I want a ALL value in both combo boxes and upon selecting that value it shouldn't filter that column.
So far my code is like this:
Sub submit()
Dim ws As Worksheet, tbl As ListObject, rng As Range
Set ws = Sheets("Graphical Summary")
Set tbl = ws.ListObjects("Table5")
Set rng = tbl.DataBodyRange
With tbl
.Range.AutoFilter Field:=1
.Range.AutoFilter Field:=3
End With
With rng
If Sheets("Graphical Summary").ComboBox1.Value = "All" Then .AutoFilter Field:=2, Criteria1:=Sheets("Graphical Summary").ComboBox2.Value
If Sheets("Graphical Summary").ComboBox1.Value <> vbNullString Then .AutoFilter Field:=1, Criteria1:=Sheets("Graphical Summary").ComboBox1.Value
If Sheets("Graphical Summary").ComboBox2.Value <> vbNullString Then .AutoFilter Field:=2, Criteria1:=Sheets("Graphical Summary").ComboBox2.Value
End With
End Sub
Currently, you do not set a filter on field 1 if ComboBox1 is a zero-length string; extend that condition to include ALL.
With rng
If ws.ComboBox1.Value <> vbNullString And
ws.ComboBox1.Value <> "All" Then _
.AutoFilter Field:=1, Criteria1:=ws.ComboBox1.Value
If ws.ComboBox2.Value <> vbNullString Then _
.AutoFilter Field:=2, Criteria1:=ws.ComboBox2.Value
End With
You've declared ws and assigned it to Sheets("Graphical Summary"); you might as well use it.
I have an AutoFilter that once it is applied it always outputs one row. I want to copy this one row and paste it on another Sheet.
I have considered:
xlCellTypeAllValidation but it throws out an error
xlCellTypeSameValidation there are many validation criteria an AutoFilter
xlCellTypeLastCell but it gives the location of the last cell in the filtered row
How can i do this?
Here is an excerpt from my code:
With ThisWorkbook.Sheets(k).Range("A1:AZ1")
.Value = .Value
.AutoFilter field:=1, Criteria1:=Rev_1
.AutoFilter field:=11, Criteria1:=Beginnings(k)
.AutoFilter field:=12, Criteria1:=End_Instnts(k)
For zz = 13 To last_Field
.AutoFilter field:=zz, Criteria1:=""
Next zz
.SpecialCells(xlCellTypeLastCell).Select
.Range.Select
ThisWorkbook.Sheets(k).AutoFilterMode = False
End With
I'd recommend testing to ensure something actually matched the criteria before you copy - something like:
With ThisWorkbook.Sheets(k).Range("A1").CurrentRegion.Resize(, 52)
.Value = .Value
.AutoFilter field:=1, Criteria1:=Rev_1
.AutoFilter field:=11, Criteria1:=Beginnings(k)
.AutoFilter field:=12, Criteria1:=End_Instnts(k)
For zz = 13 To last_Field
.AutoFilter field:=zz, Criteria1:=""
Next zz
' make sure there are results matching filter
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
' offset and resize to avoid headers then copy
.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("other sheet").Range("A1")
End If
ThisWorkbook.Sheets(k).AutoFilterMode = False
End With
You can select all filtered region and then copy it, it will copy visible rows only anyway. Or combine it with .SpeciallCells(xlCellTypeVisible)
Smthng like (after End With) (assuming data starts from Row 2)
Range("A2:AZ1").Copy Destination:=PasteRange
One approach is to use Special Cells targeting visible cells only. One really quick and painless variant is to just use offset.
See the following:
Sub CopyFilterResult()
Dim WS1 As Worksheet, WS2 As Worksheet
With ThisWorkbook
Set WS1 = .Sheets("Sheet1")
Set WS2 = .Sheets("Sheet2")
End With
'Apply your filters here.
WS1.UsedRange.Offset(1, 0).Copy WS2.Range("A1")
End Sub
Screenshots:
Source (with filter):
Result:
Something to keep as a an alternative.
Let us know if this helps.
EDIT:
This code is as per exchange in comments. Read the comments and modify it to suit your needs.
Sub CopyAfterFilterMk2()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim RngBeforeFilter As Range, RngAfterFilter As Range
Dim LCol As Long, LRow As Long
With ThisWorkbook
Set WS1 = .Sheets("Sheet1")
Set WS2 = .Sheets("Sheet2")
End With
With WS1
'Make sure no other filters are active.
.AutoFilterMode = False
'Get the correct boundaries.
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
LCol = .Range("A1").End(xlToRight).Column
'Set the range to filter.
Set RngBeforeFilter = .Range(.Cells(1, 1), .Cells(LRow, LCol))
RngBeforeFilter.Rows(1).AutoFilter Field:=1, Criteria1:="o"
'Set the new range, but use visible cells only.
Set RngAfterFilter = .Range(.Cells(2, 1), .Cells(LRow, LCol)).SpecialCells(xlCellTypeVisible)
'Copy the visible cells from the new range.
RngAfterFilter.Copy WS2.Range("A1")
'Turn off the filter.
.AutoFilterMode = False
End With
End Sub
This code handles multiple rows post-filter as well.
Let us know if this helps.