autofill to visible cells only

J

jsmith

Hello,

Any suggestions on how I can make this code ONLY copy down (autofill)
visible cells only? I do not want the value "3" copied in to hidden cells
(rows).

I've searched solutions and cannot find this specific issue.



Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=5, Criteria1:="0"
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=8, Criteria1:="0"

Range("D1").Select

Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.EntireRow.Hidden = False Then
Exit Do
End If
Loop


ActiveCell.FormulaR1C1 = "3"
ActiveCell.Copy

'****INSERT FIND LAST ROW and copy formula down
Dim LastRow As Long
Dim LastCol As Long
Dim rng As Range

With ActiveSheet
Set rng = .UsedRange 'try to reset lastused cell
With rng
LastRow = .Rows(.Rows.Count).Row
LastCol = .Columns(.Columns.Count).Column
End With

.Range("D2").AutoFill _
Destination:=.Range("D2:D" & LastRow), Type:=xlFillDefault
End With
'****END INSERT FIND LAST ROW

Thanks in advance--
Jeannell
 
J

Joel

Dim LastRow As Long
Dim LastCol As Long
Dim rng As Range

With ActiveSheet
Set rng = .UsedRange 'try to reset lastused cell
With rng
LastRow = .Rows(.Rows.Count).Row
LastCol = .Columns(.Columns.Count).Column
End With
Set DestCells = .Range("D2:D" &
LastRow).SpecialCells(xlCellTypeVisible)
.Range("D2").Copy _
Destination:=DestCells
End With
'
 
J

jsmith

Joel,
Thank you very much! That (of course) worked well.
However, when I string it together with subsequent filters/autofills, they
seem to retain the value "3" even though I have specified new values to
autofill.


Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=5, Criteria1:="0"
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=8, Criteria1:="0"
Range("D1").Select
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.EntireRow.Hidden = False Then
Exit Do
End If
Loop
ActiveCell.FormulaR1C1 = "3"
ActiveCell.Copy

'****INSERT FIND LAST ROW and copy formula down
Dim LastRow As Long
Dim LastCol As Long
Dim rng As Range

With ActiveSheet
Set rng = .UsedRange 'try to reset lastused cell
With rng
LastRow = .Rows(.Rows.Count).Row
LastCol = .Columns(.Columns.Count).Column
End With
Set DestCells = .Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible)
.Range("D2").Copy _
Destination:=DestCells
End With
'****END INSERT FIND LAST ROW

ActiveSheet.ShowAllData
Rows("1:1").Select
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=6, Criteria1:="0"
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=9, Criteria1:="0"
Range("D7").Select
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.EntireRow.Hidden = False Then
Exit Do
End If
Loop
ActiveCell.FormulaR1C1 = "6"
ActiveCell.Copy

'****INSERT FIND LAST ROW and copy formula down
With ActiveSheet
Set rng = .UsedRange 'try to reset lastused cell
With rng
LastRow = .Rows(.Rows.Count).Row
LastCol = .Columns(.Columns.Count).Column
End With
Set DestCells = .Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible)
.Range("D2").Copy _
Destination:=DestCells
End With
'****END INSERT FIND LAST ROW


ActiveSheet.ShowAllData
Rows("1:1").Select
' Selection.AutoFilter
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=7, Criteria1:="0"
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=10, Criteria1:="0"
Range("D7").Select
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.EntireRow.Hidden = False Then
Exit Do
End If
Loop
ActiveCell.FormulaR1C1 = "12"
ActiveCell.Copy

'****INSERT FIND LAST ROW and copy formula down

With ActiveSheet
Set rng = .UsedRange 'try to reset lastused cell
With rng
LastRow = .Rows(.Rows.Count).Row
LastCol = .Columns(.Columns.Count).Column
End With
Set DestCells = .Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible)
.Range("D2").Copy _
Destination:=DestCells
End With
'****END INSERT FIND LAST ROW
Range("A1").Select
ActiveSheet.ShowAllData
End Sub
 
J

jsmith

Hello again,

After further 'tweaking', my new issue is that the second and subsequent use
of:

.Range("D2").Copy _
Destination:=DestCells

....causes the "6" and "12" to not be copied down. If I comment this out the
code proceeds but does not autofill down the 6 or 12. I will have two more
subsequent filters & autofills for "24" and "36" so I only need it to
function til then.

How can I get this section to recognize the new cell to be filled down? For
each filter it will be a different and random value/location. (Data sets will
change each time the code is run, appearance and location of the 3, 6, 12,
24, and 26 values may or may not occurence in each data set and will begin in
different rows.)

I've tried changing ".Range("D2")." to ".ActiveCell.", ".UsedCell.",
".LastCell.", ".Range.", and ".Selection."
 
J

Joel

I found a few potential problems with the code below. I don't think you are
copying the rows with the data that you want. See comments below


'-----------------------------
'no sheet specified
Rows("1:1").Select
'-------------------------------
Selection.AutoFilter
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=5, Criteria1:="0"
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=8, Criteria1:="0"
Range("D1").Select
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.EntireRow.Hidden = False Then
Exit Do
End If
Loop
ActiveCell.FormulaR1C1 = "3"

'-------------------------------
'this does nothing
ActiveCell.Copy
'--------------------------------

'****INSERT FIND LAST ROW and copy formula down
Dim LastRow As Long
Dim LastCol As Long
Dim rng As Range

With ActiveSheet
Set rng = .UsedRange 'try to reset lastused cell
With rng
LastRow = .Rows(.Rows.Count).Row
LastCol = .Columns(.Columns.Count).Column
End With
Set DestCells = .Range("D2:D" & LastRow) _
.SpecialCells(xlCellTypeVisible)
.Range("D2").Copy _
Destination:=DestCells
End With
'****END INSERT FIND LAST ROW

ActiveSheet.ShowAllData

'-------------------------------
'there is no sheet specified
Rows("1:1").Select
'------------------------------
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=6, Criteria1:="0"
ActiveSheet.Range("$A$1:$CR$25587").AutoFilter Field:=9, Criteria1:="0"

'------------------------------
'no shet specified
Range("D7").Select
'------------------------------
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell.EntireRow.Hidden = False Then
Exit Do
End If
Loop
ActiveCell.FormulaR1C1 = "6"

'-----------------------------------
'does nothing
ActiveCell.Copy
'-----------------------------------

'****INSERT FIND LAST ROW and copy formula down
With ActiveSheet
Set rng = .UsedRange 'try to reset lastused cell
With rng
LastRow = .Rows(.Rows.Count).Row
LastCol = .Columns(.Columns.Count).Column
End With
Set DestCells = .Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible)
.Range("D2").Copy _
Destination:=DestCells
End With
'****END INSERT FIND LAST ROW


ActiveSheet.ShowAllData
'-----------------------------------
'no sheet specifed
Rows("1:1").Select
'------------------------------------
 
A

ART FARRELL

Hi Jeannelle,

Perhaps you can use this macro or modify it for your situation.

Row numbers in a filtered table keep their original numbers so where you
start off with D1 and offset it, it might be D2 or some larger row. This is
why I think your first fill of "3" was OK since row 2 was part of the
filtered range.

What I did in the second iteration of the filter was check to see if there
was a row 7. If not I put the For-Next in to find the next larger row. For
the example I set up it was row 9. Putting that in the fill statement the
"6" filled down correctly.

CHORDially,
Art Farrell


Option Explicit
'5/28/09

Sub AuFilt()
Dim Rng As Range, Rng1 As Range
Dim first As Long, last As Long, first2 As Long
Dim RowReqd As Long, RowNum As Long
Dim c As Variant

Set Rng = Range("A1").CurrentRegion
'takes place of ActiveSheet.Range("$A$1:$CR$25587")
Selection.AutoFilter
Rng.AutoFilter Field:=5, Criteria1:="0"
Rng.AutoFilter Field:=8, Criteria1:="0"

Set Rng1 = ActiveSheet.AutoFilter.Range
' the range that's been filtered
Set Rng1 = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1) _
.SpecialCells(xlVisible)
' eliminates Header row
first = Rng1.Row
' first row number of filtrad
last = Rng1.End(xlDown).Row
' last row number of filtrad

Range(Cells(first, 4), Cells(last, 4)).Formula = "=3"
' fills "3" down in Column D
Selection.AutoFilter
'********************************
Set Rng = Range("A1").CurrentRegion
'takes place of ActiveSheet.Range("$A$1:$CR$25587")
Selection.AutoFilter
Rng.AutoFilter Field:=6, Criteria1:="0"
Rng.AutoFilter Field:=9, Criteria1:="0"

Set Rng1 = ActiveSheet.AutoFilter.Range
' the range that's been filtered
Set Rng1 = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1) _
.SpecialCells(xlVisible)
' eliminates Header row
first2 = Rng1.Row
' first row number of filtrad
last = Rng1.End(xlDown).Row
' last row number of filtrad

RowReqd = 7
'it appears this is the row you want to start from

For Each c In Rng1
RowNum = c.Row
If RowNum >= RowReqd Then Exit For
' checks each row to se if there is a row 7
' if not, it selects the next larger row
Next c

Range(Cells(RowNum, 4), Cells(last, 4)).Formula = "=6"
' fills "6" down in Column D from row 7 or larger to end

Selection.AutoFilter
'********************************
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

filter that yeilds no results 6
Error on Autofill 2
Advanced Filter Error - I cannot spot my Error 3
How to set range to autofiltered visible cells? 7
Autofill not working. 3
Ron de Bruin - Merge cells from all worksheets 0
Copy Autofilter Source Workbook A result in Destination Workbook BSheet1 1
Select rows equal to filter and highlight row 4

Top