Transposing selected column headings
Gareth,
As was pointed out, Tom was aware of Edwin's code, I was not, so he took
that into account, I produced a more generic solution.
Bob
"Gar3th" wrote in message
...
Hi Bob
Thanks for the response. The initial data on the sheet does not have any
blank lines between the authority so when I run your code on this it
appears
to insert the correct number of lines and the headings. Tom's works after
I
have used Edwin Tam's code to insert the blank lines first.
Anyway once again thanks
Gareth
"Bob Phillips" wrote:
It shouldn't make any difference, as the whole point of the first code
segment is to remove the blanks (I couldn't determine whether there
would be
one, or one per authority, so I decided to remove that variable).
Therefore,
if there are none, nothing happens, if there it removes them, either
way, it
starts from the same base point.
It may be important, as I see you say that both mine and Tom's version
works. As I said, I couldn't determine your blank rows, and if there is
just
1 blank row between them, Tom's solution gives a different result to
mine.
Only you can determine which is correct, but just to put you on notice.
Regards
Bob
"Gar3th" wrote in message
...
Hi Bob
Thankyou very much for this it appears to work well. Out of interest
the
comment on the first bit says 'first get rid of the useless blank
lines.
However, if I run this on a spreadsheet with blank lines it inserts
additional blanks. If I run it on a sheet without blank lines between
the
names it puts the correct number in.
Again my colleague is extremely grateful having saved many days of
work
and
helping the efficiency of the NHS.
"Bob Phillips" wrote:
Sub Reformat()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long, j As Long, k As Long
'first get rid of the useless blank lines
cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 2 Step -1
If Cells(i, "A") = "" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
'then re-jig the data
cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = cLastRow To 2 Step -1
cLastCol = Cells(i, Columns.Count).End(xlToLeft).Column
k = 0
For j = 2 To cLastCol
If Cells(i, j).Value < 0 And _
UCase(Cells(i, j).Value < "N") Then
If k 0 Then
Cells(i + k, "A").EntireRow.Insert
End If
Cells(i + k, "Q").Value = Cells(1, j).Value
Cells(i + k, "R").Value = Cells(i, j).Value
k = k + 1
End If
Next j
Next i
End Sub
--
HTH
RP
(remove nothere from the email address if mailing direct)
"Gar3th" wrote in message
...
Hi
In Excel 2000 I have a spreadsheet with a list of staff names in
column
A. Columns B to P are head with different item types for which they
can
sign. Under these headers is either a value or text entry. I have
inserted
a blank row
for each header that contains an entry other than 0 or "N".
Item
and
Amount are additional column headers.
Name Invoices Petty Cash Cheques Holiday Forms Mat Leave
Item
Amt
G Smith £1000 £100 0 Y N
J Brown 0 0 £100 Y Y
Jeff Black £500 £500 0 N N
Etc
Now I want to place the headers, where the entry is anything but
0
and
'N', in the blank rows starting in the next column Q headed Item
and
the
entry in the cell below in the column headed Amount to give:
Name Invoices Petty Cash Cheques Holiday Forms Mat Leave
Item
Amt
G Smith £1000 £100 0 Y N
Invoices£1000
Petty Ca £100
Holiday F Y
J Brown 0 0 £100 Y Y
Cheques
£100
Holiday F Y
Mat Leave Y
J Black £500 £500 0 N N
Invoices
£500
Petty Ca £500
Etc
I will be extremely grateful if anyone can supply a solution.
Regards
Gareth
PS If Edwin Tam sees this it is a follow on from the auto insert
you
provide
which has worked beautifully.
|