AutoFilter

[jacqui]

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

 

[Tom Ogilvy]

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

 

[jacqui]

Tom
Thank you for your reply. I have to admit the Function
thing is a bit advanced for me and yes you're right
without you seeing the entire process it's difficult to
know how it all fits together. As a thought would a Do
Loop added to your original code work instead? I've
modified as below so that you can see what I'm getting at
but please bear in mind it's possibly incorrectly coded.
Would you mind having a look for me?
Many thanks
Jacqui


Dim i As Long, j As Long, k As Long, n As Long
Dim iStartRow As Long

Dim rng As Range, cell As Range
Dim sChar As String


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
Do Until cell.EntireRow.Hidden = False
iStartRow = cell.Row
Loop

If cell.EntireRow.Hidden = False Then
sChar = Left(cell, 1)
If IsNumeric(sChar) Then
k = CLng(sChar)
If k = i Then
Cells(iStartRow, j).Value = Cells(cell.Row,
6).Value
iStartRow = iStartRow + 1
n = n + 1
End If
End If
End If
Next
Next

End Sub

 

[Tom Ogilvy]

One possibility using a loop:

Dim i As Long, j As Long, k As Long, n As Long
Dim iStartRow As Long, iRow as Long

Dim rng As Range, cell As Range
Dim sChar As String


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 cells(rows.count,1).End(xlup)
if rows(i).EntireRow.Hidden = false then
iStartRow = i
exit for
end if
next

For Each cell In rng
For i = 1 To 8
j = j + 1
iRow = iStartRow
Set rng = Range(Cells(2, 1), _\
Cells(Rows.Count, 1).End(xlUp))


If cell.EntireRow.Hidden = False Then
sChar = Left(cell, 1)
If IsNumeric(sChar) Then
k = CLng(sChar)
If k = i Then
Cells(iRow, j).Value = _
Cells(cell.Row,6).Value
iStartRow = iStartRow + 1
End If
End If
End If
Next
Next