Transposing Data

[jacqui]

Tom Ogilvy kindly provided the following code (see below)
which looks at the balances in my datafile in row format
and then organises them across columns. In the example I
gave him this worked fine as it was only a particular
section of the overall data,. However I am now working
with the complete file and using autofilter to filter each
block of related data. ok the problem I have is that the
code puts the balances in row 2 for every new column
(sorry Tom I advised you this I know) whereas what I'd
like it to do is check each row for the balances as before
but because autofilter is on, VBA needs to insert the
column balances from the first visible row, example
The filter criteria = "Affinity", these balances appear in
rows 378 to 753 in my datafile, what I'd like it to do is
place the data in the respective columns but use the row
378 as the start point. The filter then finds "Belfast",
and the associated balances are in rows 754:1129 but I
need it to place the data in columns starting at row 754.
The next block of data starts from 1130 and so on.
How do I rewrite the following code. It seems to me like
I need a entirerow.hidden = false type statement to
determine the first row each time. Can anyone please help.
Many thanks
Jacqui

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
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

Next
Next

End Sub

 

[Tom Ogilvy]

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

Possibly

 

[jacqui]

Tom,

Thanks for your reply, it's almost there but it needs a
minor fix. The best way I can explan is using
the "Affinity" example which starts on row 378. The macro
below has inserted the values in new columns and has
incremented the column each time ie F then G then H but
this is against the original row ie G378, then H425, then
I472. What I'm trying to do is put the values in new
columns but in the first visible row of each block of
filtered data, ie G378, H378, I378.
I guess the code needs amending on the Cells(cell.Row,
j).Value = Cells(cell.Row, 6).Value line somehow but I'm
nowhere near clever enough to know how to do that. Can
you kindly help?
Many thanks
Jacqui

 

[Tom Ogilvy]

Dim i As Long, j As Long, k As Long, n As Long
Dim rng As Range, cell As Range
Dim sChar As String
Dim colFil as Range, rngFil as Range

n = 2
Worksheets("Table4").Select

set rngFil = Activesheet.Autofilter.Range
set rngFil = rng.offset(1,0).Resize(rng.rows.count - 1).EntireRow

For i = 1 To 256
set colfil = Intersect(Columns(i),rngFil)
If Application.SubTotal(3,colFil)) = 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

Possibly