Change Loop to Auto Filter - excel

I want to simplify the following code by changing the loop structure to an auto filter structure.
1
ActiveCell.Columns("A:A").EntireColumn.Select
If Selection.Find(What:="~* C", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True) Is Nothing Then
GoTo 2
End If
Selection.Find(What:="~* C", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True).Activate
ActiveCell.Select
Range(Selection, Selection.Offset(0, 1)).Insert shift:=xlToRight
GoTo 1
2

Try this one:
Sub test()
Dim lastrow As Long
Dim rng As Range
Dim ar As Range
'change Sheet1 to suit
With ThisWorkbook.Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 'find last row in column A
.AutoFilterMode = False 'remove previous filter
With .Range("A1:A" & lastrow)
.AutoFilter Field:=1, Criteria1:="*~* C*" 'apply filter
On Error Resume Next
Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) 'find visible rows
On Error GoTo 0
End With
.AutoFilterMode = False 'remove filter
'if we found some values - insert
If Not rng Is Nothing Then
rng.Insert Shift:=xlToRight
rng.Insert Shift:=xlToRight
End If
End With
End Sub
If your column A doesn't contain header, use this one for rng:
Set rng = .SpecialCells(xlCellTypeVisible)
Btw, this post may help you in future: How to avoid using Select/Active statements

ActiveCell.Columns("A:A").EntireColumn.Select
Selection.AutoFilter 'resets any current autofilter
Selection.AutoFilter Field:=1, Criteria1:="=~* C", Operator:=xlFilterValues
and once filter is applied I usually use something like:
dim rng as range
set rng = ActiveSheet.cells.SpecialCells(xlCellTypeVisible)
that gets you all of the visible cells, which with a filter active, are only the ones that match the filter criteria.
edit
at the beginning do this:
dim numrows as long
dim numcolumns as long
numrows = Cells.find("*", [A1], , , xlByRows, xlPrevious).Row
numcolumns = Cells.find("*", [A1], , , xlByColumns, xlPrevious).Column
then before filtering do this: set rng = Range("A1", Cells(numrows,numcolumns))
and then after filter, instead of Activesheet use: set rng = rng.cells.SpecialCells(xlCellTypeVisible) so that way it gets only the visible cells within the used range

Related

Selecting a range until the last used row

I am trying to select a range until the last used row in the sheet. I currently have the following:
Sub Select_Active_Down()
Dim lr As Long
lr = ActiveSheet.UsedRange.Rows.Count
If Cells(ActiveCell.Row, ActiveCell.Column) = Cells(lr, ActiveCell.Column) Then
MsgBox "There isn't any data to select."
Else
Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(lr, ActiveCell.Column)).Select
Cells(lr, ActiveCell.Column).Activate
End If
End Sub
The issue is that I need to select multiple columns, and this will only select the first column of the active range. How can I modify this to select multiple columns rather than just the first?
What about selection the entire region? This can be done as follows in VBA:
Selection.CurrentRegion.Select
There also is the possibility to select the entire array. For that, just press Ctrl+G, choose Special and see over there.
I would do this slightly different. I would use .Find to find the last row and the last column (using the same logic shown in the link) to construct my range rather than using Selection | Select | ActiveCell | UsedRange | ActiveSheet.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim rng As Range
'~~> Change it to the relevant sheet
Set ws = Sheet1
With ws
'~~> Check if there is data
If Application.WorksheetFunction.CountA(.Cells) = 0 Then
MsgBox "No Data Found"
Exit Sub
End If
'~~> Find last row
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'~~> Find last column
LastColumn = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'~~> Construct your range
Set rng = .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
'~~> Work with the range
With rng
MsgBox .Address
'
'~~> Do what you want with the range here
'
End With
End With
End Sub

Trying to find value in range and get its row. Variable not set error?

The code below is supposed to take the value for net in each month, copies it, search for net name in range1(another worksheet) and pastes value in the cell corresponding to that row and column "AA".
This part of code is having issue:
Set Netrng = Range("AA" & Range1.Find(What:=Net, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Rows.row)
The error is -
object variable or with block variable not set.
what am I doing wrong?
Sub test()
Dim Range2 As Range
Dim lRow As Long
Dim Count As Long
Dim Net As String
Dim Line As Range
Dim Netrng As Range
Dim First As Range
Dim Range1 As Range
Dim wb As Worksheet
Set First = ActiveCell
Set wb = ActiveSheet
Set Range1 = wb.Range(First, First.End(xlDown))
ActiveWindow.ActivatePrevious
ActiveSheet.PivotTables("PivotTable1").PivotFields("Client Code").CurrentPage _
= "BUN"
ActiveSheet.Range("B5").Activate
lRow = Cells(Rows.Count, 1).End(xlUp).row - 6
Set Range2 = Range(ActiveCell.Offset(2, -1), ActiveCell.Offset(lRow, -1))
Set Months = Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 2))
Count = 1
While Count <= Range2.Count
Set Line = Range2.Rows(Count)
Net = Line.Value
Line.Offset(0, 1).Copy
ActiveWindow.ActivatePrevious
Set Netrng = Range("AA" & Range1.Find(What:=Net, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).row)
Netrng.Offset(0, 4).PasteSpecial Paste:=xlPasteValues
Netrng.Value = 0
ActiveWindow.ActivatePrevious
Line.Offset(0, 2).Copy
ActiveWindow.ActivatePrevious
Netrng.Offset(0, 8).PasteSpecial Paste:=xlPasteValues
ActiveWindow.ActivatePrevious
Count = Count + 1
Wend
End Sub
As is, the code is assuming that the Find is successful, which may not always be the case.
To test:
Dim foundRng as Range
Set foundRng = Range1.Find(What:=Net, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not FoundRng is Nothing Then
Set Netrng = Range("AA" & foundRng.Row)
...
End If
Other recommendations:
Avoid using Select and Activate. (and ActiveCell, ActiveWindow, anything Active).
Fully qualify which Workbook and Worksheet each Range is on (helpful reading in the answer on avoiding Select).
While...Wend is old-fashioned. Use a For Each loop.

Shifting Dynamic Columns to the Right VBA (Object req'd error)

I am trying to select columns based on their heading value and then move them over to the end on the right. I know it is selecting the columns correctly, and identifying the next empty column. However, when running the code, it'll get down to the emptyRange.select.offset and then gives an error saying an object is required.
I'm not sure if I am overcomplicating this code.
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim emptyRange As Range
With Sheets("Data")
Set dCol = Range( _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
Set qCol = Range( _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
End With
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
Exit For
End If
Next cell
dCol.Select
Selection.Cut
emptyRange.Select.Offset
Selection.Insert Shift:=xlToRight
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
Exit For
End If
Next cell
qCol.Select
Selection.Cut
emptyRange.Select
Selection.Insert Shift:=xlToRight
End Sub
Sloppy solution below
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim emptyRange As Range
Dim MyRange As Range
Dim iCounter As Long
With Sheets("Data")
Set dCol = Range( _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
Set qCol = Range( _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
End With
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
col = ActiveCell.Column
Exit For
End If
Next cell
dCol.Select
Selection.Cut
Cells(1, col).Select
ActiveSheet.Paste
'Blank Column Deleter
Set MyRange = ActiveSheet.UsedRange
For iCounter = MyRange.Columns.Count To 1 Step -1
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
Next iCounter
'
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
col = ActiveCell.Column
Exit For
End If
Next cell
qCol.Select
Selection.Cut
Cells(1, col).Select
ActiveSheet.Paste
'Blank Column Deleter
Set MyRange = ActiveSheet.UsedRange
For iCounter = MyRange.Columns.Count To 1 Step -1
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
Next iCounter
End Sub
Couple of problems I see.
1) You are not checking if emptyRange is allocated with an object reference before trying to access it. Now, your worksheet might never have a data width that exceeds column "ZZ", but that is not good practice. That could be your problem, but it might not be - I wouldn't be able to tell without seeing your data.
2) I don't see what you are trying to do there with Offset. You haven't specified an argument for rows up/down or columns left/right so it's really not doing anything. Also, I don't think you can use it after a select statement like that. If you wanted to do that you would do:
emptyRange.Select
Selection.Offset(0,1) `this would offset one column - not sure what you wanted to do
But that whole selection step is unnecessary as you can work with the object directly:
emptyRange.Offset(0,1)
As to whether or not you're overcomplicating things: yes - you can simplify this code quite a bit by getting rid of all the Activate & Select methods and just working with the objects directly.
Instead of looping over all the cells in A1:ZZ1, just use the Find method again. The other benefit of this, is that using find as I've done below will always return an object (in excel 2007 and up) so you won't need a check like I mentioned above.
I don't particularly like the use of two find statements to create a range of used data for dCol and qCol - I found it difficult to read and interpret what you were doing. Here again I wouldn't use a fixed sized range as I mentioned above - this makes your code more fragile. I actually think it's a lot easier to read and understand if you break this into two operations: 1) find the column, 2) resize the range down to the last row in the column
You can avoid a second loop by using Offset to just move over one column, and you can eliminate the insert line by providing the destination argument for cut.
EDIT after OP posted "sloppy solution":
You can greatly simplify the code by just selecting the entire column and inserting it before the last empty column. You then don't need any routine to cleanup blank columns.
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim destination As Range
With Sheets("Data").Cells
'Find the cell in row 1 which contains "name_a"
Set dCol = .Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False).EntireColumn
'Repeat same steps for qCol
Set qCol = .Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False).EntireColumn
'Find the last column which has data in it, and get the next column over (the first empty column)
Set destination = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious).Offset(0, 1).EntireColumn
End With
'Insert dCol before the first empty column at the end of the data range:
dCol.Cut
destination.Insert shift:=xlShiftToRight
'Insert qCol before that same empty column
qCol.Cut
destination.Insert shift:=xlShiftToRight
End Sub

Cleaner way of "finding" a range of values

So I currently a macro that assigns a cell value to a variable and then search for this variable on a another sheet. The problem is that I am having to do this a large number values so I currently have the same code copied 20 times allowing for 20 values to be search in series. Is there a cleaner method of running a repeatable operation like this? Also is it possible to set the upper limit based on the number of values entered. E.g. my current setup looks cells M8:M27 for it's variables, is it possible however to write it so that it is repeated continuously until it hits a blank cell? Thereby letting the user enter as many values as required?
Here is an extract for a single variable. This is then repeated up to reverse_id_20
Sheets("GR Input").Select
reverse_id_1 = Range("O8")
Sheets("PchOrds").Select
Columns("A:A").Select
Selection.Find(What:=reverse_id_1, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
Sheets("GR Input").Select
Thanks in advance guys,
Dan
Is there a cleaner method of running a repeatable operation like this?
Yes, it is. You can use loop for it:
Sub test()
Dim reverse_id As Variant
Dim rng As Range
Dim r_id As Variant
With Sheets("GR Input")
reverse_id = .Range("O8:O11")
End With
For Each r_id In reverse_id
Set rng = Sheets("PchOrds").Columns("A:A").Find( _
What:=r_id, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False)
If Not rng Is Nothing Then
rng.EntireRow.Delete Shift:=xlUp
End If
Next r_id
End Sub
Btw, code above deletes only first row that meet criteria. If you'd like to delete all values from sheet "PchOrds", that meet criteria, use this code:
Sub test1()
Dim reverse_id As Variant
Dim rng As Range
Dim lastrow As Long
Dim r_id As Variant
With Sheets("GR Input")
reverse_id = .Range("O8:O11")
End With
For Each r_id In reverse_id
If r_id <> "" Then
With Sheets("PchOrds")
lastrow = Application.Max(2, .Cells(.Rows.Count, "A").End(xlUp).Row)
.AutoFilterMode = False
With .Range("A1:A" & lastrow)
.AutoFilter Field:=1, Criteria1:="=*" & r_id & "*"
.Offset(1, 0).Resize(lastrow - 1, 1).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End If
Next r_id
End Sub

Find last column assigned in Range

I need to find out the column that is the last column in a range that is defined with:
Set RngSource = ActiveWorkbook.ActiveSheet.UsedRange
First things first
Never use UsedRange to set your range. I have explained it HERE as to why you shouldn't use UsedRange
Set RngSource = ActiveWorkbook.ActiveSheet.UsedRange
Find the Last Column that has data and the Last Row which has data and then set your range. So your question of finding the last column from the range will not arise. Here is an example
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Dim lRow As Long, lCol As Long
'~~> Set your worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
'~~> Find Last Row
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'~~> Find Last Column
lCol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Else
lRow = 1: lCol = 1
End If
'~~> Set your range
Set rng = .Range(.Cells(1, 1), .Cells(lRow, lCol))
Debug.Print rng.Address
End With
End Sub
Use End(xlToRight) with an activecell.

Resources