Select first visible cell directly beneath the header of a filtered column - vba

I am trying to select the first visible cell directly beneath the header of a filtered column. The code I am getting is as below, but I have to problems with this code. First, the first line of code is using the current active range of the file. It is highly likely that this file will change and this range will not be the same. How can I make it work for any file I would use it on? Second, if I use a totally different file with the same column format, the first visible cell under Column J could be J210. How can I make this work for any array of variables?
Sub Macro16()
'
' Macro16 Macro
'
'
ActiveSheet.Range("$A$1:$R$58418").AutoFilter Field:=12, Criteria1:= _
"Sheets"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[1],3)"
Selection.FillDown
End Sub

Sub FirstVisibleCell()
With Worksheets("You Sheet Name").AutoFilter.Range
Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With
End Sub

Untested but:
Sub Macro16()
With ActiveSheet.Range("A1").CurrentRegion
.AutoFilter field:=12, Criteria1:="Sheets"
If .Columns(1).SpecialCells(xlCellTypeVisible).count > 1 Then
With .Columns(10)
.Resize(.rows.count - 1).offset(1).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RIGHT(RC[1],3)"
End With
End If
End With
End Sub

I prefer non-destructive methods of determining whether there are visible cells to work with after a filtering operation. Since you are filling in column J with a formula, there is no guarantee that column J contains any values tat can be counted with the worksheet's SUBTOTAL function (SUBTOTAL does not count rows hidden by a filter) but the formula you are planning to populate into column J references column K so there must be something there.
Sub Macro16()
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
.Columns(12).AutoFilter Field:=1, Criteria1:="Sheets"
With .Resize(.Rows.Count - 1, 1).Offset(1, 9)
If CBool(Application.Subtotal(103, .Offset(0, 1))) Then
.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RIGHT(RC[1],3)"
End If
End With
.Columns(12).AutoFilter Field:=1
End With
End With
End Sub
      

Something like this might work...
Sub Macro16()
Dim ARow As Long, JRow As Long, ws1 As Worksheet
ws1 = Sheets("NAME OF SHEET WITH DATA")
ARow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1
ws1.Range("$A$1:$R$" & ARow).AutoFilter Field:=12, Criteria1:="Sheets"
JRow = ws1.Range("J" & ws1.Rows.Count).End(xlUp).Row + 1
ws1.Range("J" & JRow).FormulaR1C1 = "=RIGHT(RC[1],3)"
ws1.Range("J" & JRow).FillDown
End Sub

Related

How to select the filtered data without including the column names using excel VBA?

Below is the code that I came up with, however, the issue lies in the 3rd line wherein the filtered data does not necessarily start in row 2. If the first data point satisfying the criteria is located at row 150, then it would return an error:
Total_Rows_Compiled = Worksheets("Compiled").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Compiled").Range("$A$1:$G$52818").AutoFilter Field:=1, Criteria1:=Worksheets("Sheet1").Cells(l, 1)
Worksheets("Compiled").Range("A2:G" & Total_Rows_Compiled).SpecialCells(xlCellTypeVisible).Select
There doesn't appear to be anything substantially wrong with your code. With that in mind, the following is a combination of methods that I have found to be reasonably error free.
with Worksheets("Compiled")
.activate
if .autofiltermode then .autofiltermode = false
Total_Rows_Compiled = .Range("A" & .Rows.Count).End(xlUp).Row
with .range("A1:G" & Total_Rows_Compiled)
.AutoFilter Field:=1, Criteria1:=Worksheets("Sheet1").Cells(l, 1)
with .resize(.rows.count-1, .columns.count).offset(1, 0)
if cbool(application.subtotal(103, .cells)) then
.SpecialCells(xlCellTypeVisible).Select
end if
end with
end with
end with
You could loop through the Areas:
Dim filterRange As Range, filteredRange As Range, area As Range
Set filterRange = Worksheets("Compiled").Range("$A$1:$G$52818")
filterRange.AutoFilter Field:=1, Criteria1:=Worksheets("Sheet1").Cells(l, 1)
Set filteredRange = Intersect(filterRange, filterRange.Offset(1, 0)).SpecialCells(xlCellTypeVisible) 'remove headers
If Not filteredRange Is Nothing Then
For Each area In filteredRange.Areas
'do something with area
Debug.Print area.Address
Next area
End If
The following data, when filtered on "test", returns the ranges (areas) B2:F2 and B4:F5 as required

VBA not looping filtered rows

I have this big excel file that is automated to do some processes. Today, I figured there is an issue with one of the columns and I need to fix it. to fix it I am generated this code below to filter column N to show all '#N/A'. with the filtered rows, I want to check and see if the offset to the right 2 columns has the value "Available". if it does, I want to loop through all column N and replace the '#N/A' with 'Unkown'. but the code I generated only works for the first filtered cell and doesn't loop.
Sub tess()
ActiveSheet.Range("$C$1:$AR$468").AutoFilter Field:=12, Criteria1:="#N/A"
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(, 12).Select
Dim lr
lr = ActiveSheet.UsedRange.Rows.CountLarge
For Each cell In Range("n1:n" & lr)
If ActiveCell.Value = CVErr(xlErrNA) And ActiveCell.Offset(, 2).Value = "Available" Then
ActiveCell.Value = "Unkown Person"
End If
Next cell
End Sub
Thank you.
you can avoid looping by adding another filter:
Sub tess()
With ActiveSheet.Range("$C$1:$AR$468")
.AutoFilter Field:=12, Criteria1:="#N/A"
.AutoFilter Field:=14, Criteria1:="Available"
If Application.WorksheetFunction.Subtotal(103, .Columns(12)) > 1 Then .Offset(1, 11).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Value = "Unkown Person"
.Parent.AutoFilterMode = False
End With
End Sub
You should refer to "cell" within your For loop, not "ActiveCell".

VBA Look through List

I've got the following code which gets the word dividend from a column and then takes the whole row and copy pastes it to a new sheet.
Sub SortActions()
Dim i&, k&, s$, v, r As Range, ws As Worksheet
Set r = [index(a:a,match("###start",a:a,),):index(a:a,match("###end",a:a,),)].Offset(, 6)
k = r.Row - 1
v = r
For i = 1 To UBound(v)
If LCase$(v(i, 1)) = "dividend" Then
s = s & ", " & i + k & ":" & i + k
End If
Next
s = Mid$(s, 3)
If Len(s) Then
Set ws = ActiveSheet
With Sheets.Add(, ws)
ws.Range(s).Copy .[a1]
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("20140701_corporate_action_servi").Select
Rows("2:2").Select
Selection.Copy2
Range("C32").Select
Sheets("Sheet11").Select
ActiveSheet.Paste
End With
End If
End Sub
Is there a way to make this dynamic. So if I want to search for more than word. For example if I have several rows with dividends and special dividends -> it would take all rows of dividends and all rows of special dividends and put them in separate sheets. I have tried ti with recording a macro it doesn't work as the words can differ. Maybe getting the content into a list would work. Please assist . Thanks
As suggested by #Macro Man , I am submitting images of an example sheet and sheet after filter with a simple macro for filtering one field. Please all credit to #Macro Man, it is for illustration in a simple way.
Simple code as follows.
Sub Filter1Field()
With Sheet1
.AutoFilterMode = False
With .Range("A1:H13")
.AutoFilter
.AutoFilter Field:=5, Criteria1:="Dividend"
End With
End With
End Sub
*****UPDATE*******
If your other criteria such as "Sp. Dividend" is other field but on the same row as shown in the image appended and you wish to copy to other sheet you can use the code given below. Another image shows results obtained on sheet2. You can adopt the code to your requrements.
You can use this code:
Sub Test2()
Dim LastRow As Long
Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
.Range("A1:H13").AutoFilter
.Range("A1:H13").AutoFilter field:=5, Criteria1:="Dividend"
.Range("A1:H13").AutoFilter field:=6, Criteria1:="=Sp. Dividend"
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Sheets("Sheet2").Range("A1")
End With
End Sub

For loop to change a specific cell in a formula

I have a formula that shows which rows in a specific column meet a set of criteria. When the formula is executed and applied to all rows, I run a loop to check which rows returned a value as a text, and then copy-pastes this cells to another worksheet:
Sub loop1()
Dim r As Range, c As Range
With Worksheets("Sheet1")
Set r = Range(.Range("AF2"), .Range("AF2").End(xlDown))
For Each c In r
If WorksheetFunction.IsText(c) Then
Range(.Cells(c.Row, "AF"), .Cells(c.Row, "AF")).Copy
Else
GoTo nextc
End If
With Worksheets("Sheet2")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
nextc:
Next c
End With
Application.CutCopyMode = False
End Sub
What I want to do now is to run the formula for 631 different names, copy-paste every name as a headline and then run loop1. I cant figure out though how to make the for loop work inside the formula.
Sub loop2()
Dim i As Integer
For i = 2 To 632
Sheets("Sheet1").Select
Range("AC2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]=""district1"",(IF(RC[2]=R2C33 ,(IF(RC[-18]>=1,0,(IF(RC[-16]>=1,0,IF(RC[-14]>=1,0,IF(RC[-12]>=1,0,IF(RC[-10]>=1,1,IF(RC[-8]>=1,1,IF(RC[-6]>=1,1,0))))))))),0)),0)"
Range("AC2").Select
Selection.AutoFill Destination:=Range("AC2:AC20753")
Range("AC2:AC20753").Select
Range("AG2").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Selection.Font.Bold = True
Sheets("Sheet1").Select
Application.Run "'Customers.xlsb'!loop1"
Next i
End Sub
The cells that need to be changed for every loop are, R2C33 to something like RiC33 (which doesn't work) and the "headline" Range("AG2").Select to something like Range("AGi").Select.
Anyone who could help?
The following code will do the trick:
Sub loop2()
Dim i As Integer
For i = 2 To 632
Sheets("Sheet1").Range("AC2:AC20753").FormulaR1C1 = _
"=IF(RC[-3]=""district1"",(IF(RC[2]=R" & i & "C33 ,(IF(RC[-18]>=1,0,(IF(RC[-16]>=1,0,IF(RC[-14]>=1,0,IF(RC[-12]>=1,0,IF(RC[-10]>=1,1,IF(RC[-8]>=1,1,IF(RC[-6]>=1,1,0))))))))),0)),0)"
Sheets("Sheet1").Range("AG" & i).Copy Destination:=Sheets("Sheet2").Range("A1")
Sheets("Sheet2").Range("A1").Font.Bold = True
Application.Run "'Customers.xlsb'!loop1"
Next i
End Sub
In order to let i be used within your String formula you have to stop the String " use & i & and continue the String ".
I have also changed your code to prevent the use of .Select, which is a no no in VBA.
This way it fills in your Formula copy's and changes the Font without selecting anything or changing sheets.
As Jeep noted you do however need to change Sheets(""Sheet2").Range("A1") as I don't know which cell you want to paste into.
Your first sub procedure might be better like this.
Sub loop1()
Dim r As Range, c As Range
With Worksheets("Sheet1")
Set r = Range(.Range("AF2"), .Range("AF2").End(xlDown))
For Each c In r
If WorksheetFunction.IsText(c) Then
Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = _
.Cells(c.Row, "AF").Value2
End If
Next c
End With
End Sub
Direct value transfer is preferred over a Copy, Paste Special, Values.
In the second sub procedure, you don't have to do anything but remove the 2 from R2C33; e.g. RC33. In xlR1C1 formula construction a lone R simply means the row that the formula is on and you are starting at row 2. You can also put all of the formulas in at once. Once they are in you can looop through the G2:G632 cells.
Sub loop2()
Dim i As Integer
With Sheets("Sheet1")
.Range("AC2:AC20753").FormulaR1C1 = _
"=IF(OR(AND(RC[-3]=""district1"", RC[2]=R2C33, RC[-18]>=1), SUM(RC[-16], RC[-14], RC[-12])>=1), 0, IF(SUM(RC[-10], RC[-8], RC[-6])>=1, 1, 0))"
For i = 2 To 632
.Range("AG" & i).Copy _
Destination:=Sheets("Sheet2").Somewhere
Sheets("Sheet2").Somewhere.Font.Bold = True
Application.Run "'Customers.xlsb'!loop1"
Next i
Next i
End Sub
I also tightened up your formula by grouping some of the conditions that would result in zero together with OR and AND functions.
The only thing remaining would be defining the Destination:=Sheets("Sheet2").Somewhere I left hanging.

how to copy one column from one spreadsheet to another

I am trying to copy the data from column A in spreadsheet called "Dividends" and paste in spreadsheet called "Draft" but there`s an error. My code looks like that:
Sub copy_2()
Sheets("Dividends").Range("A").Copy
Sheets("Draft").Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
You don't need to copy/paste either - you can just set the ranges equal.
Sub copy()
Dim lastRow As Integer
'This will let us know the last used row in column A
lastRow = Sheets("Dividends").Cells(1, 1).End(xlDown).row
Sheets("Draft").Range(Sheets("Draft").Cells(1, 1), Sheets("Draft").Cells(lastRow, 1)).Value = Sheets("Dividends").Range(Sheets("Dividends").Cells(1, 1), Sheets("Dividends").Cells(lastRow, 1)).Value
End Sub
Or you can copy/paste:
Sub copy()
Dim lastRow As Integer
'This will let us know the last used row in column A
lastRow = Sheets("Dividends").Cells(1, 1).End(xlDown).row
Sheets("Dividends").Range(Sheets("Dividends").Cells(1, 1), Sheets("Dividends").Cells(lastRow, 1)).copy _
Destination:=Sheets("Draft").Range(Sheets("Draft").Cells(1, 1), Sheets("Draft").Cells(lastRow, 1))
Application.CutCopyMode = False
End Sub
Note: If you have a gap anywhere in Column A, the lastRow integer might be off. If you want to copy all the way down to the last used row, replace the "lastRow = " with this:
lastRow = Sheets("Dividends").UsedRange.Rows.Count
Sub copy_2()
Sheets("Dividends").Range("A:A").Copy
Sheets("Draft").Paste
Application.CutCopyMode = False
End Sub
Removing references to Active as much as possible helps eliminate confusion.
This works,
Sheets("Dividends").Range("A:A").Copy Sheets("Draft").Range("A1")