AutoFilter
Public Function firstRow(wks As Worksheet)
Dim arng As Range, arng1 As Range
Dim rngFirstRow As Range
If Not wks.AutoFilterMode Then
firstRow = 0
Exit Function
End If
Set arng = wks.AutoFilter.Range
Set arng = arng.Offset(1, 0).Resize(arng.Rows.Count - 1)
On Error Resume Next
Set arng1 = arng.Columns(1).SpecialCells(xlVisible)
On Error GoTo 0
If Not arng1 Is Nothing Then
Set rngFirstRow = arng1(1)
firstRow = rngFirstRow.Row
Else
Set rngFirstRow = Nothing
firstRow = 0
End If
End Function
I have no Idea how this all fits together, so you will have to figure out
how to use the above code.
if you want the first visible row in the autofilter use it like
frow = FirstRow(activesheet)
So my guess would be:
Dim ws as Worksheet
Dim i As Long, j As Long, k As Long, n As Long
Dim rng As Range, cell As Range
Dim sChar As String
ws = Worksheets("Table4")
Worksheets("Table4").Select
For i = 1 To 256
If Application.CountA(Columns(i)) = 0 Then
j = i - 1
Exit For
End If
Next
For i = 1 To 8
j = j + 1
n = firstRow(ws)
Set rng = Range(Cells(2, 1), _
Cells(Rows.Count, 1).End (xlUp))
For Each cell In rng
' If cell.EntireRow.Hidden = False Then
sChar = Left(cell, 1)
If IsNumeric(sChar) Then
k = CLng(sChar)
If k = i Then
Cells(n, j).Value = Cells(cell.Row, 6).Value
n = n + 1
End If
' End If
End If
Next
Next
End Sub
--
Regards,
Tom Ogilvy
"jacqui" wrote in message
...
In the following code (full code below), how do I make the
first visible row from the Autofilter selection my
variable in the line which says
Cells(cell.Row, j).Value = Cells(cell.Row, 6).Value
At the moment VBA is inserting the value in the correct
column but inserting it in the row opposite the value. I
need an anchor to represent the first visible row for each
autofilter repetition. Tom if you are still on-line can
you possibly help urgently with this one please.
Many thanks
Jacqui
Full code is
Dim i As Long, j As Long, k As Long, n As Long
Dim rng As Range, cell As Range
Dim sChar As String
n = 2
Worksheets("Table4").Select
For i = 1 To 256
If Application.CountA(Columns(i)) = 0 Then
j = i - 1
Exit For
End If
Next
For i = 1 To 8
j = j + 1
n = 2
Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End
(xlUp))
For Each cell In rng
If cell.EntireRow.Hidden = False Then
sChar = Left(cell, 1)
If IsNumeric(sChar) Then
k = CLng(sChar)
If k = i Then
Cells(cell.Row, j).Value = Cells(cell.Row, 6).Value
n = n + 1
End If
End If
End If
Next
Next
End Sub
|