Looping through visible cells

[StevenM]

Here is a snippet of working code:

--------------------------------------------------------------------------------------
' change all blank task ids with worktype Release to a lookup based
' on taskname
Selection.AutoFilter Field:=7, Criteria1:="="
Selection.AutoFilter Field:=6, Criteria1:="Release"

firstrow = getfirstrow()
lastrow = getlastrow("F")
Range("G" & firstrow).Select
ActiveCell.Value = "=VLOOKUP($H" & firstrow &
",TaskNameIds.xls!TasknameIdTbl,2,FALSE)"
Selection.Copy
Range("G" & firstrow & ":G" & lastrow).Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Clear the filters and copy in all of G to get the values for the lookups
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=7
firstrow = getfirstrow()
lastrow = getlastrow("G")

Range("G" & firstrow & ":G" & lastrow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' change all blank task names to the investment names for ID* projects
Selection.AutoFilter Field:=8, Criteria1:="="
Selection.AutoFilter Field:=4, Criteria1:="ID*
--------------------------------------------------------------------------------------

I am trying to find a way to do it more efficiently. The spreadsheet this
is operating on has about 12000+ rows. I originally tried to copy the
copy/paste special/values on the filtered data. I got an error saying the
copy area and paste area are not the same size and shape. So I cleared the
filter and selected the column from first row to last row and copy/paste
special. It works but it takes a very long time to do as it is operating on
12000+ rows, even though only some of
those rows actually has a formula.

How can I leave the filter on, and step through the range of visible cells
to do the copy/pastespecial? Will that be more efficient/faster?

TIA.

 

[Don Guillett]

I can't figure out what you are doing.
If you are trying to change formulas to values either of these will do it
quickly

Sub changetovalue()
Columns("G").Value = Columns("G").Value
'Range("g1:g21").Value = Range("g1:g21").Value
End Sub

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

 

[StevenM]

What I am trying to do is replace the formula
ActiveCell.Value = "=VLOOKUP($H" & firstrow & ",TaskNameIds.xls!
TasknameIdTbl,2,FALSE)
with the values by doing copy, then paste special/values. But I only want
to do it on those visible cells after the filter is on.

So more specifically, Is there some way I can set up a "For Each" loop and
go through the visible cells in the column and run the copy/paste special
command one cell at a time? I am assuming that will be more efficient than
doing the entire column of 12000+ entries, when only maybe 100 cells actually
have the formula and the other cells just have a value already done.

 

[Dave Peterson]

Try this manually (maybe while you're recording a macro).

(After the data is filtered, too)
select the leftmost column of the tasknameidtbl (column A???)
Hit F5 (edit|Goto or ctrl-g)
Special|Visible cells only.

And your selection will be the visible cells in that selected area (that's why I
wanted you to select a single column first.

Then you could loop through that visible range.

Here's a procedure that I've posted before:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim VisRng As Range
Dim myRng As Range
Dim myCell As Range

Set wks = ActiveSheet

With wks
'just a single column
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))

'remove any existing filter
.AutoFilterMode = False
myRng.AutoFilter Field:=1, Criteria1:="somevalue"

With .AutoFilter.Range.Columns(1)
If .Cells.SpecialCells(xlCellTypeVisible).cells.count = 1 Then
MsgBox "only header visible"
Else
'avoid the header
Set VisRng = .Resize(.Cells.Count - 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
For Each myCell In VisRng.Cells
MsgBox myCell.Address 'or whatever you need to do
Next myCell
End If
End With
.AutoFilterMode = False 'remove the filter
End With
End Sub


=========
If you have lots of these "=vlookup()" to do, you may want to find out why your
copy|paste of the visible cells didn't work.

This kind of thing worked ok for me:

Option Explicit
Sub testme()

Dim NewWks As Worksheet
Dim wks As Worksheet
Dim myRng As Range

Set wks = Worksheets("sheet1")

With wks
Set myRng = .AutoFilter.Range.Cells.SpecialCells(xlCellTypeVisible)
End With

Set NewWks = Worksheets.Add

myRng.Copy _
Destination:=NewWks.Range("A1")

End Sub

In fact, I think it was xl97 that was the last version that needed that
xlcelltypevisible stuff. xl2k and above's default behavior is to copy just the
visible cell (which can be a pain!).

xl97 would copy the entire range (visible and hidden) if you didn't use syntax.

 

[OssieMac]

Hi Steven,

I am not certain that I have interpretted you question properly but try the
following. It uses the AutoFilter visible cell range of the specified column.

Feel free to get back to me if it does not do what you want.

An explanation of the following line of code so you understand what the code
is doing. (Note that the space and underscore at the end of a line is a line
break in an otherwise single line of code.)

Set rngBlank = .Columns(7) _
.Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)

..Columns(7) is the 7th column of the AutoFilter range.
..Offset(1, 0) moves the range down one row off the column headers but in
doing so it then includes an additional line at the bottom of the range.
..Resize(.Rows.Count - 1, 1) removes the additional line on the bottom.
..SpecialCells(xlCellTypeVisible) is self explanatory.

Sub test()

Dim rngBlank As Range
Dim firstRow As Long
Dim c As Range

With ActiveSheet
If .FilterMode Then .ShowAllData
End With

With ActiveSheet.UsedRange
.AutoFilter Field:=6, Criteria1:="Release"
.AutoFilter Field:=7, Criteria1:="="
End With

With ActiveSheet.AutoFilter.Range
'Test that some visible data.
'Note that column header is one visible
'cell and hense looking for > 1
If .Columns(7) _
.SpecialCells(xlCellTypeVisible) _
.Count > 1 Then

'Set rngBlank to column 7 visible cells only
Set rngBlank = .Columns(7) _
.Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
Else
MsgBox "No visible data cells." & vbLf _
& "Processing terminated."
Exit Sub
End If

End With


With rngBlank
'Row number of first cell in rngBlank
firstRow = .Cells(1, 1).Row

'Insert formula in first cell of rngBlank
.Cells(1, 1) = "=VLOOKUP(H" & firstRow & _
",TaskNameIds.xls!TasknameIdTbl,2,FALSE)"

'Copy the formula and paste to all visible cells.
'Note that it does not matter that the
'formula is pasted over itself.
.Cells(1, 1).Copy Destination:=rngBlank

End With

For Each c In rngBlank
c.Copy
c.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Next c

With ActiveSheet.AutoFilter.Range
'Clear the filters
.AutoFilter Field:=6
.AutoFilter Field:=7
End With

Application.CutCopyMode = False

'Following code looks like next part of project.
'therefore Exit sub in test
Exit Sub

' change all blank task names to the investment names for ID* projects
With ActiveSheet.AutoFilter.Range
.AutoFilter Field:=8, Criteria1:="="
.AutoFilter Field:=4, Criteria1:="ID*"
End With

End Sub

 

[Don Guillett]

Try this instead of looping. Change col A to col G

Sub changeVISIBLEtovalue()
lr = Cells(Rows.Count, "a").End(xlUp).Row
Range("a1:a" & lr).SpecialCells(xlCellTypeVisible).Value = _
Range("a1:a" & lr).SpecialCells(xlCellTypeVisible).Value
End Sub

 

[StevenM]

Thank you all for the replies. I appreciate the explanations along with the
code so I can learn what the techniques are doing.

Very appreciatively,
Steven

 

[StevenM]

This was just the ticket:
Range("a1:a" & lr).SpecialCells(xlCellTypeVisible).Value = _
Range("a1:a" & lr).SpecialCells(xlCellTypeVisible).Value

Thanks, the whole macro now is really quick.

 

[OssieMac]

Hi Steven,

I am really at a loss as to how you got the following code to work. Every
which way I test it, it copies the value of the first cell to all of the
cells. It works on contiguous cells so perhaps your cells are contiguous but
that cannot be guaranteed on filtered data. I cannot get it to work on the
non contiguous cells.

This was just the ticket:
Range("a1:a" & lr).SpecialCells(xlCellTypeVisible).Value = _
Range("a1:a" & lr).SpecialCells(xlCellTypeVisible).Value

 

[Don Guillett]

Does not work as written unless 1st value is on row 2.
HOWEVER, if changed to a2 and there is a header it works just fine for non
contiguous.
Tested below for filtering on 3

Range("a2:a" & lr).SpecialCells(xlCellTypeVisible).Value = _
Range("a2:a" & lr).SpecialCells(xlCellTypeVisible).Value

a
2
2
22
3
22
3
2



-
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

 

[OssieMac]

Hi Don,

Your example only worked because you copy/pasted over the filtered column
where all the values are the same and therefore copying the first value over
them all does not matter. In the OP's request, the filtering was on one
column and the formulas in the adjacent column. The formulas did not all
return the same values. My testing all pasted the first value over all the
formulas where there was non contiguous rows of data.