View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Transposing selected column headings

He has been posting for a couple of days. His initial post asked for code
to put in the correct number of blank lines. He received that code from
Edward Tam as I recall and so my assumption was he had the correct number of
lines and so I didn't try to do more than he asked.

--
Regards,
Tom Ogilvy

"Bob Phillips" wrote in message
...
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.