View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
OssieMac OssieMac is offline
external usenet poster
 
Posts: 2,510
Default Looping through visible cells

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


--
Regards,

OssieMac