I have several columns of data such as follows:

A B C D E
Op # Op Desc Mechanical Electrical Fire
10 Desc #1 mech 1 elect 1
10 Desc #2 elect 2 fire 1
20 Desc #3 mech 2 fire 2
20 Desc #4 mech 3 elect 3

The end result must be a sort of the data by Op # and then by the hazard
category (columns C-E) with each hazard category on it's own row as follows:

10 Desc #1 mech 1
10 Desc #1 elect 1
10 Desc #2 elect 2
10 Desc #2 fire 1
20 Desc #3 mech 2
20 Desc #3 fire 2
20 Desc #4 mech 3
20 Desc #4 elect 3

Any ideas? There could be up to 300 original versions of the rows of data
to sort this way.

Thanks for any help.

this is code I wrote yesterday for another posting. I modified yesterdays
code becasue you only have two columns that need to be copied to every row
and yesterdays posting had 3 columns that need to be copied to every row.
the code is copying the data from sheet1 and putting the results in sheet2.
The macro runs faster if you put the data into a new worksheet.

Sub Transpose()

Set SourceSht = Sheets("sheet1")
Set DestSht = Sheets("sheet2")
With DestSht
.Range("A1") = "ID"
.Range("B1") = "Surname"
.Range("C1") = "Name"
.Range("D1") = "Choises"
End With

With SourceSht
SourceRow = 2
DestRow = 2
Do While .Range("A" & SourceRow) <> ""
'set Copyrange to equal columns A - C
Set CopyRange = _
.Range("A" & SourceRow & ":B" & SourceRow)
ColCount = 3
Do While .Cells(SourceRow, ColCount) <> ""
CopyRange.Copy _
Destination:=DestSht.Range("A" & DestRow)
Choice = .Cells(SourceRow, ColCount).Value
DestSht.Range("C" & DestRow) = Choice
DestRow = DestRow + 1
ColCount = ColCount + 1
Loop
SourceRow = SourceRow + 1
Loop
End With
End Sub





"Jeff Gross" wrote:

> I have several columns of data such as follows:
>
> A B C D E
> Op # Op Desc Mechanical Electrical Fire
> 10 Desc #1 mech 1 elect 1
> 10 Desc #2 elect 2 fire 1
> 20 Desc #3 mech 2 fire 2
> 20 Desc #4 mech 3 elect 3
>
> The end result must be a sort of the data by Op # and then by the hazard
> category (columns C-E) with each hazard category on it's own row as follows:
>
> 10 Desc #1 mech 1
> 10 Desc #1 elect 1
> 10 Desc #2 elect 2
> 10 Desc #2 fire 1
> 20 Desc #3 mech 2
> 20 Desc #3 fire 2
> 20 Desc #4 mech 3
> 20 Desc #4 elect 3
>
> Any ideas? There could be up to 300 original versions of the rows of data
> to sort this way.
>
> Thanks for any help.

Thanks alot Joel.

I was actually looking at that post before posting my own. The code you
provided is putting blank rows in when there is a blank in the cell of a
particular column. I could do a subsequent re-sort and that would remove
them but if I could just get the code to not put a blank row in when there is
a blank cell, that would be very helpful.

Jeff

"Joel" wrote:

> this is code I wrote yesterday for another posting. I modified yesterdays
> code becasue you only have two columns that need to be copied to every row
> and yesterdays posting had 3 columns that need to be copied to every row.
> the code is copying the data from sheet1 and putting the results in sheet2.
> The macro runs faster if you put the data into a new worksheet.
>
> Sub Transpose()
>
> Set SourceSht = Sheets("sheet1")
> Set DestSht = Sheets("sheet2")
> With DestSht
> .Range("A1") = "ID"
> .Range("B1") = "Surname"
> .Range("C1") = "Name"
> .Range("D1") = "Choises"
> End With
>
> With SourceSht
> SourceRow = 2
> DestRow = 2
> Do While .Range("A" & SourceRow) <> ""
> 'set Copyrange to equal columns A - C
> Set CopyRange = _
> .Range("A" & SourceRow & ":B" & SourceRow)
> ColCount = 3
> Do While .Cells(SourceRow, ColCount) <> ""
> CopyRange.Copy _
> Destination:=DestSht.Range("A" & DestRow)
> Choice = .Cells(SourceRow, ColCount).Value
> DestSht.Range("C" & DestRow) = Choice
> DestRow = DestRow + 1
> ColCount = ColCount + 1
> Loop
> SourceRow = SourceRow + 1
> Loop
> End With
> End Sub
>
>
>
>
>
> "Jeff Gross" wrote:
>
> > I have several columns of data such as follows:
> >
> > A B C D E
> > Op # Op Desc Mechanical Electrical Fire
> > 10 Desc #1 mech 1 elect 1
> > 10 Desc #2 elect 2 fire 1
> > 20 Desc #3 mech 2 fire 2
> > 20 Desc #4 mech 3 elect 3
> >
> > The end result must be a sort of the data by Op # and then by the hazard
> > category (columns C-E) with each hazard category on it's own row as follows:
> >
> > 10 Desc #1 mech 1
> > 10 Desc #1 elect 1
> > 10 Desc #2 elect 2
> > 10 Desc #2 fire 1
> > 20 Desc #3 mech 2
> > 20 Desc #3 fire 2
> > 20 Desc #4 mech 3
> > 20 Desc #4 elect 3
> >
> > Any ideas? There could be up to 300 original versions of the rows of data
> > to sort this way.
> >
> > Thanks for any help.

copy this code to a standard module.



Option Explicit
Sub sortdata()
Dim lastrow As Long
Dim rw As Long
lastrow = Range("A1").End(xlDown).Row

'copy column A twice
Range(Range("A1"), Range("B1").End(xlDown)).Copy
Range("A1").End(xlDown).Offset(1).PasteSpecial xlPasteAll
Range("A1").End(xlDown).Offset(1).PasteSpecial xlPasteAll

'copy column D to C below existing B
Range(Range("D1"), Cells(lastrow, "D")).Copy
Range("C1").Offset(lastrow).PasteSpecial xlPasteAll

'copy column E to C below existing B
Range(Range("E1"), Cells(lastrow, "E")).Copy
Range("C1").Offset(lastrow * 2).PasteSpecial xlPasteAll

Columns(4).Cells.Clear
Columns(5).Cells.Clear

For rw = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(rw, "C") = "" Then
Rows(rw).Delete
End If
Next
End Sub


"Jeff Gross" <(E-Mail Removed)> wrote in message
news:283A937D-A5B8-4BE5-84E4-(E-Mail Removed)...
> I have several columns of data such as follows:
>
> A B C D
> E
> Op # Op Desc Mechanical Electrical Fire
> 10 Desc #1 mech 1 elect 1
> 10 Desc #2 elect 2
> fire 1
> 20 Desc #3 mech 2 fire
> 2
> 20 Desc #4 mech 3 elect 3
>
> The end result must be a sort of the data by Op # and then by the hazard
> category (columns C-E) with each hazard category on it's own row as
> follows:
>
> 10 Desc #1 mech 1
> 10 Desc #1 elect 1
> 10 Desc #2 elect 2
> 10 Desc #2 fire 1
> 20 Desc #3 mech 2
> 20 Desc #3 fire 2
> 20 Desc #4 mech 3
> 20 Desc #4 elect 3
>
> Any ideas? There could be up to 300 original versions of the rows of data
> to sort this way.
>
> Thanks for any help.

I don't think those cells are really empty. Try this change

from:
Do While .Cells(SourceRow, ColCount) <> ""
to:
Do While trim(.Cells(SourceRow, ColCount)) <> ""

"Jeff Gross" wrote:

> Thanks alot Joel.
>
> I was actually looking at that post before posting my own. The code you
> provided is putting blank rows in when there is a blank in the cell of a
> particular column. I could do a subsequent re-sort and that would remove
> them but if I could just get the code to not put a blank row in when there is
> a blank cell, that would be very helpful.
>
> Jeff
>
> "Joel" wrote:
>
> > this is code I wrote yesterday for another posting. I modified yesterdays
> > code becasue you only have two columns that need to be copied to every row
> > and yesterdays posting had 3 columns that need to be copied to every row.
> > the code is copying the data from sheet1 and putting the results in sheet2.
> > The macro runs faster if you put the data into a new worksheet.
> >
> > Sub Transpose()
> >
> > Set SourceSht = Sheets("sheet1")
> > Set DestSht = Sheets("sheet2")
> > With DestSht
> > .Range("A1") = "ID"
> > .Range("B1") = "Surname"
> > .Range("C1") = "Name"
> > .Range("D1") = "Choises"
> > End With
> >
> > With SourceSht
> > SourceRow = 2
> > DestRow = 2
> > Do While .Range("A" & SourceRow) <> ""
> > 'set Copyrange to equal columns A - C
> > Set CopyRange = _
> > .Range("A" & SourceRow & ":B" & SourceRow)
> > ColCount = 3
> > Do While .Cells(SourceRow, ColCount) <> ""
> > CopyRange.Copy _
> > Destination:=DestSht.Range("A" & DestRow)
> > Choice = .Cells(SourceRow, ColCount).Value
> > DestSht.Range("C" & DestRow) = Choice
> > DestRow = DestRow + 1
> > ColCount = ColCount + 1
> > Loop
> > SourceRow = SourceRow + 1
> > Loop
> > End With
> > End Sub
> >
> >
> >
> >
> >
> > "Jeff Gross" wrote:
> >
> > > I have several columns of data such as follows:
> > >
> > > A B C D E
> > > Op # Op Desc Mechanical Electrical Fire
> > > 10 Desc #1 mech 1 elect 1
> > > 10 Desc #2 elect 2 fire 1
> > > 20 Desc #3 mech 2 fire 2
> > > 20 Desc #4 mech 3 elect 3
> > >
> > > The end result must be a sort of the data by Op # and then by the hazard
> > > category (columns C-E) with each hazard category on it's own row as follows:
> > >
> > > 10 Desc #1 mech 1
> > > 10 Desc #1 elect 1
> > > 10 Desc #2 elect 2
> > > 10 Desc #2 fire 1
> > > 20 Desc #3 mech 2
> > > 20 Desc #3 fire 2
> > > 20 Desc #4 mech 3
> > > 20 Desc #4 elect 3
> > >
> > > Any ideas? There could be up to 300 original versions of the rows of data
> > > to sort this way.
> > >
> > > Thanks for any help.

I looked at your data and didn't realize the differences between the code I
provided and then posting I responded to yesterday. Try these imporvements

Sub Transpose()

Set SourceSht = Sheets("sheet1")
Set DestSht = Sheets("sheet2")
With DestSht
.Range("A1") = "Op #"
.Range("B1") = "OP Desc"
.Range("C1") = "Hazard"
End With

With SourceSht
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
SourceRow = 2
DestRow = 2
Do While .Range("A" & SourceRow) <> ""
'set Copyrange to equal columns A - C
Set CopyRange = _
.Range("A" & SourceRow & ":B" & SourceRow)
For Colcount = 3 To LastCol
If .Cells(SourceRow, Colcount) <> "" Then
CopyRange.Copy _
Destination:=DestSht.Range("A" & DestRow)
Hazard = .Cells(SourceRow, Colcount).Value
DestSht.Range("C" & DestRow) = Hazard
DestRow = DestRow + 1
End If
Next Colcount
SourceRow = SourceRow + 1
Loop
End With
End Sub




"Jeff Gross" wrote:

> Thanks alot Joel.
>
> I was actually looking at that post before posting my own. The code you
> provided is putting blank rows in when there is a blank in the cell of a
> particular column. I could do a subsequent re-sort and that would remove
> them but if I could just get the code to not put a blank row in when there is
> a blank cell, that would be very helpful.
>
> Jeff
>
> "Joel" wrote:
>
> > this is code I wrote yesterday for another posting. I modified yesterdays
> > code becasue you only have two columns that need to be copied to every row
> > and yesterdays posting had 3 columns that need to be copied to every row.
> > the code is copying the data from sheet1 and putting the results in sheet2.
> > The macro runs faster if you put the data into a new worksheet.
> >
> > Sub Transpose()
> >
> > Set SourceSht = Sheets("sheet1")
> > Set DestSht = Sheets("sheet2")
> > With DestSht
> > .Range("A1") = "ID"
> > .Range("B1") = "Surname"
> > .Range("C1") = "Name"
> > .Range("D1") = "Choises"
> > End With
> >
> > With SourceSht
> > SourceRow = 2
> > DestRow = 2
> > Do While .Range("A" & SourceRow) <> ""
> > 'set Copyrange to equal columns A - C
> > Set CopyRange = _
> > .Range("A" & SourceRow & ":B" & SourceRow)
> > ColCount = 3
> > Do While .Cells(SourceRow, ColCount) <> ""
> > CopyRange.Copy _
> > Destination:=DestSht.Range("A" & DestRow)
> > Choice = .Cells(SourceRow, ColCount).Value
> > DestSht.Range("C" & DestRow) = Choice
> > DestRow = DestRow + 1
> > ColCount = ColCount + 1
> > Loop
> > SourceRow = SourceRow + 1
> > Loop
> > End With
> > End Sub
> >
> >
> >
> >
> >
> > "Jeff Gross" wrote:
> >
> > > I have several columns of data such as follows:
> > >
> > > A B C D E
> > > Op # Op Desc Mechanical Electrical Fire
> > > 10 Desc #1 mech 1 elect 1
> > > 10 Desc #2 elect 2 fire 1
> > > 20 Desc #3 mech 2 fire 2
> > > 20 Desc #4 mech 3 elect 3
> > >
> > > The end result must be a sort of the data by Op # and then by the hazard
> > > category (columns C-E) with each hazard category on it's own row as follows:
> > >
> > > 10 Desc #1 mech 1
> > > 10 Desc #1 elect 1
> > > 10 Desc #2 elect 2
> > > 10 Desc #2 fire 1
> > > 20 Desc #3 mech 2
> > > 20 Desc #3 fire 2
> > > 20 Desc #4 mech 3
> > > 20 Desc #4 elect 3
> > >
> > > Any ideas? There could be up to 300 original versions of the rows of data
> > > to sort this way.
> > >
> > > Thanks for any help.

You're right - the cells are not truely blank but have a formula. Would a
paste special values only take care of that issue?

"Joel" wrote:

> I looked at your data and didn't realize the differences between the code I
> provided and then posting I responded to yesterday. Try these imporvements
>
> Sub Transpose()
>
> Set SourceSht = Sheets("sheet1")
> Set DestSht = Sheets("sheet2")
> With DestSht
> .Range("A1") = "Op #"
> .Range("B1") = "OP Desc"
> .Range("C1") = "Hazard"
> End With
>
> With SourceSht
> LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
> SourceRow = 2
> DestRow = 2
> Do While .Range("A" & SourceRow) <> ""
> 'set Copyrange to equal columns A - C
> Set CopyRange = _
> .Range("A" & SourceRow & ":B" & SourceRow)
> For Colcount = 3 To LastCol
> If .Cells(SourceRow, Colcount) <> "" Then
> CopyRange.Copy _
> Destination:=DestSht.Range("A" & DestRow)
> Hazard = .Cells(SourceRow, Colcount).Value
> DestSht.Range("C" & DestRow) = Hazard
> DestRow = DestRow + 1
> End If
> Next Colcount
> SourceRow = SourceRow + 1
> Loop
> End With
> End Sub
>
>
>
>
> "Jeff Gross" wrote:
>
> > Thanks alot Joel.
> >
> > I was actually looking at that post before posting my own. The code you
> > provided is putting blank rows in when there is a blank in the cell of a
> > particular column. I could do a subsequent re-sort and that would remove
> > them but if I could just get the code to not put a blank row in when there is
> > a blank cell, that would be very helpful.
> >
> > Jeff
> >
> > "Joel" wrote:
> >
> > > this is code I wrote yesterday for another posting. I modified yesterdays
> > > code becasue you only have two columns that need to be copied to every row
> > > and yesterdays posting had 3 columns that need to be copied to every row.
> > > the code is copying the data from sheet1 and putting the results in sheet2.
> > > The macro runs faster if you put the data into a new worksheet.
> > >
> > > Sub Transpose()
> > >
> > > Set SourceSht = Sheets("sheet1")
> > > Set DestSht = Sheets("sheet2")
> > > With DestSht
> > > .Range("A1") = "ID"
> > > .Range("B1") = "Surname"
> > > .Range("C1") = "Name"
> > > .Range("D1") = "Choises"
> > > End With
> > >
> > > With SourceSht
> > > SourceRow = 2
> > > DestRow = 2
> > > Do While .Range("A" & SourceRow) <> ""
> > > 'set Copyrange to equal columns A - C
> > > Set CopyRange = _
> > > .Range("A" & SourceRow & ":B" & SourceRow)
> > > ColCount = 3
> > > Do While .Cells(SourceRow, ColCount) <> ""
> > > CopyRange.Copy _
> > > Destination:=DestSht.Range("A" & DestRow)
> > > Choice = .Cells(SourceRow, ColCount).Value
> > > DestSht.Range("C" & DestRow) = Choice
> > > DestRow = DestRow + 1
> > > ColCount = ColCount + 1
> > > Loop
> > > SourceRow = SourceRow + 1
> > > Loop
> > > End With
> > > End Sub
> > >
> > >
> > >
> > >
> > >
> > > "Jeff Gross" wrote:
> > >
> > > > I have several columns of data such as follows:
> > > >
> > > > A B C D E
> > > > Op # Op Desc Mechanical Electrical Fire
> > > > 10 Desc #1 mech 1 elect 1
> > > > 10 Desc #2 elect 2 fire 1
> > > > 20 Desc #3 mech 2 fire 2
> > > > 20 Desc #4 mech 3 elect 3
> > > >
> > > > The end result must be a sort of the data by Op # and then by the hazard
> > > > category (columns C-E) with each hazard category on it's own row as follows:
> > > >
> > > > 10 Desc #1 mech 1
> > > > 10 Desc #1 elect 1
> > > > 10 Desc #2 elect 2
> > > > 10 Desc #2 fire 1
> > > > 20 Desc #3 mech 2
> > > > 20 Desc #3 fire 2
> > > > 20 Desc #4 mech 3
> > > > 20 Desc #4 elect 3
> > > >
> > > > Any ideas? There could be up to 300 original versions of the rows of data
> > > > to sort this way.
> > > >
> > > > Thanks for any help.

Lets try putting the trim into the new code. I try a test a found a formula
that is returning nothing ("") two double quotes with no spaces will be
recognized with the following statment as being true.

If .Cells(SourceRow, Colcount) <> "" Then

It is not the formula that causing the problem but the value that is being
returned by the formula. Probably is returning a non-blank string. Using
trim will remove any blanks.


from
If .Cells(SourceRow, Colcount) <> "" Then
to
If Trim(.Cells(SourceRow, Colcount)) <> "" Then


"Jeff Gross" wrote:

> You're right - the cells are not truely blank but have a formula. Would a
> paste special values only take care of that issue?
>
> "Joel" wrote:
>
> > I looked at your data and didn't realize the differences between the code I
> > provided and then posting I responded to yesterday. Try these imporvements
> >
> > Sub Transpose()
> >
> > Set SourceSht = Sheets("sheet1")
> > Set DestSht = Sheets("sheet2")
> > With DestSht
> > .Range("A1") = "Op #"
> > .Range("B1") = "OP Desc"
> > .Range("C1") = "Hazard"
> > End With
> >
> > With SourceSht
> > LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
> > SourceRow = 2
> > DestRow = 2
> > Do While .Range("A" & SourceRow) <> ""
> > 'set Copyrange to equal columns A - C
> > Set CopyRange = _
> > .Range("A" & SourceRow & ":B" & SourceRow)
> > For Colcount = 3 To LastCol
> > If .Cells(SourceRow, Colcount) <> "" Then
> > CopyRange.Copy _
> > Destination:=DestSht.Range("A" & DestRow)
> > Hazard = .Cells(SourceRow, Colcount).Value
> > DestSht.Range("C" & DestRow) = Hazard
> > DestRow = DestRow + 1
> > End If
> > Next Colcount
> > SourceRow = SourceRow + 1
> > Loop
> > End With
> > End Sub
> >
> >
> >
> >
> > "Jeff Gross" wrote:
> >
> > > Thanks alot Joel.
> > >
> > > I was actually looking at that post before posting my own. The code you
> > > provided is putting blank rows in when there is a blank in the cell of a
> > > particular column. I could do a subsequent re-sort and that would remove
> > > them but if I could just get the code to not put a blank row in when there is
> > > a blank cell, that would be very helpful.
> > >
> > > Jeff
> > >
> > > "Joel" wrote:
> > >
> > > > this is code I wrote yesterday for another posting. I modified yesterdays
> > > > code becasue you only have two columns that need to be copied to every row
> > > > and yesterdays posting had 3 columns that need to be copied to every row.
> > > > the code is copying the data from sheet1 and putting the results in sheet2.
> > > > The macro runs faster if you put the data into a new worksheet.
> > > >
> > > > Sub Transpose()
> > > >
> > > > Set SourceSht = Sheets("sheet1")
> > > > Set DestSht = Sheets("sheet2")
> > > > With DestSht
> > > > .Range("A1") = "ID"
> > > > .Range("B1") = "Surname"
> > > > .Range("C1") = "Name"
> > > > .Range("D1") = "Choises"
> > > > End With
> > > >
> > > > With SourceSht
> > > > SourceRow = 2
> > > > DestRow = 2
> > > > Do While .Range("A" & SourceRow) <> ""
> > > > 'set Copyrange to equal columns A - C
> > > > Set CopyRange = _
> > > > .Range("A" & SourceRow & ":B" & SourceRow)
> > > > ColCount = 3
> > > > Do While .Cells(SourceRow, ColCount) <> ""
> > > > CopyRange.Copy _
> > > > Destination:=DestSht.Range("A" & DestRow)
> > > > Choice = .Cells(SourceRow, ColCount).Value
> > > > DestSht.Range("C" & DestRow) = Choice
> > > > DestRow = DestRow + 1
> > > > ColCount = ColCount + 1
> > > > Loop
> > > > SourceRow = SourceRow + 1
> > > > Loop
> > > > End With
> > > > End Sub
> > > >
> > > >
> > > >
> > > >
> > > >
> > > > "Jeff Gross" wrote:
> > > >
> > > > > I have several columns of data such as follows:
> > > > >
> > > > > A B C D E
> > > > > Op # Op Desc Mechanical Electrical Fire
> > > > > 10 Desc #1 mech 1 elect 1
> > > > > 10 Desc #2 elect 2 fire 1
> > > > > 20 Desc #3 mech 2 fire 2
> > > > > 20 Desc #4 mech 3 elect 3
> > > > >
> > > > > The end result must be a sort of the data by Op # and then by the hazard
> > > > > category (columns C-E) with each hazard category on it's own row as follows:
> > > > >
> > > > > 10 Desc #1 mech 1
> > > > > 10 Desc #1 elect 1
> > > > > 10 Desc #2 elect 2
> > > > > 10 Desc #2 fire 1
> > > > > 20 Desc #3 mech 2
> > > > > 20 Desc #3 fire 2
> > > > > 20 Desc #4 mech 3
> > > > > 20 Desc #4 elect 3
> > > > >
> > > > > Any ideas? There could be up to 300 original versions of the rows of data
> > > > > to sort this way.
> > > > >
> > > > > Thanks for any help.

Joel - thanks for all your help.

The code works except for one thing. The Op # is being properly copied down
for each row but the Op Description is not being properly copied. It copies
directly from sheet1 b2 and b3 to sheet2 b2 and b3.

Any ideas?

Jeff

"Joel" wrote:

> Lets try putting the trim into the new code. I try a test a found a formula
> that is returning nothing ("") two double quotes with no spaces will be
> recognized with the following statment as being true.
>
> If .Cells(SourceRow, Colcount) <> "" Then
>
> It is not the formula that causing the problem but the value that is being
> returned by the formula. Probably is returning a non-blank string. Using
> trim will remove any blanks.
>
>
> from
> If .Cells(SourceRow, Colcount) <> "" Then
> to
> If Trim(.Cells(SourceRow, Colcount)) <> "" Then
>
>
> "Jeff Gross" wrote:
>
> > You're right - the cells are not truely blank but have a formula. Would a
> > paste special values only take care of that issue?
> >
> > "Joel" wrote:
> >
> > > I looked at your data and didn't realize the differences between the code I
> > > provided and then posting I responded to yesterday. Try these imporvements
> > >
> > > Sub Transpose()
> > >
> > > Set SourceSht = Sheets("sheet1")
> > > Set DestSht = Sheets("sheet2")
> > > With DestSht
> > > .Range("A1") = "Op #"
> > > .Range("B1") = "OP Desc"
> > > .Range("C1") = "Hazard"
> > > End With
> > >
> > > With SourceSht
> > > LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
> > > SourceRow = 2
> > > DestRow = 2
> > > Do While .Range("A" & SourceRow) <> ""
> > > 'set Copyrange to equal columns A - C
> > > Set CopyRange = _
> > > .Range("A" & SourceRow & ":B" & SourceRow)
> > > For Colcount = 3 To LastCol
> > > If .Cells(SourceRow, Colcount) <> "" Then
> > > CopyRange.Copy _
> > > Destination:=DestSht.Range("A" & DestRow)
> > > Hazard = .Cells(SourceRow, Colcount).Value
> > > DestSht.Range("C" & DestRow) = Hazard
> > > DestRow = DestRow + 1
> > > End If
> > > Next Colcount
> > > SourceRow = SourceRow + 1
> > > Loop
> > > End With
> > > End Sub
> > >
> > >
> > >
> > >
> > > "Jeff Gross" wrote:
> > >
> > > > Thanks alot Joel.
> > > >
> > > > I was actually looking at that post before posting my own. The code you
> > > > provided is putting blank rows in when there is a blank in the cell of a
> > > > particular column. I could do a subsequent re-sort and that would remove
> > > > them but if I could just get the code to not put a blank row in when there is
> > > > a blank cell, that would be very helpful.
> > > >
> > > > Jeff
> > > >
> > > > "Joel" wrote:
> > > >
> > > > > this is code I wrote yesterday for another posting. I modified yesterdays
> > > > > code becasue you only have two columns that need to be copied to every row
> > > > > and yesterdays posting had 3 columns that need to be copied to every row.
> > > > > the code is copying the data from sheet1 and putting the results in sheet2.
> > > > > The macro runs faster if you put the data into a new worksheet.
> > > > >
> > > > > Sub Transpose()
> > > > >
> > > > > Set SourceSht = Sheets("sheet1")
> > > > > Set DestSht = Sheets("sheet2")
> > > > > With DestSht
> > > > > .Range("A1") = "ID"
> > > > > .Range("B1") = "Surname"
> > > > > .Range("C1") = "Name"
> > > > > .Range("D1") = "Choises"
> > > > > End With
> > > > >
> > > > > With SourceSht
> > > > > SourceRow = 2
> > > > > DestRow = 2
> > > > > Do While .Range("A" & SourceRow) <> ""
> > > > > 'set Copyrange to equal columns A - C
> > > > > Set CopyRange = _
> > > > > .Range("A" & SourceRow & ":B" & SourceRow)
> > > > > ColCount = 3
> > > > > Do While .Cells(SourceRow, ColCount) <> ""
> > > > > CopyRange.Copy _
> > > > > Destination:=DestSht.Range("A" & DestRow)
> > > > > Choice = .Cells(SourceRow, ColCount).Value
> > > > > DestSht.Range("C" & DestRow) = Choice
> > > > > DestRow = DestRow + 1
> > > > > ColCount = ColCount + 1
> > > > > Loop
> > > > > SourceRow = SourceRow + 1
> > > > > Loop
> > > > > End With
> > > > > End Sub
> > > > >
> > > > >
> > > > >
> > > > >
> > > > >
> > > > > "Jeff Gross" wrote:
> > > > >
> > > > > > I have several columns of data such as follows:
> > > > > >
> > > > > > A B C D E
> > > > > > Op # Op Desc Mechanical Electrical Fire
> > > > > > 10 Desc #1 mech 1 elect 1
> > > > > > 10 Desc #2 elect 2 fire 1
> > > > > > 20 Desc #3 mech 2 fire 2
> > > > > > 20 Desc #4 mech 3 elect 3
> > > > > >
> > > > > > The end result must be a sort of the data by Op # and then by the hazard
> > > > > > category (columns C-E) with each hazard category on it's own row as follows:
> > > > > >
> > > > > > 10 Desc #1 mech 1
> > > > > > 10 Desc #1 elect 1
> > > > > > 10 Desc #2 elect 2
> > > > > > 10 Desc #2 fire 1
> > > > > > 20 Desc #3 mech 2
> > > > > > 20 Desc #3 fire 2
> > > > > > 20 Desc #4 mech 3
> > > > > > 20 Desc #4 elect 3
> > > > > >
> > > > > > Any ideas? There could be up to 300 original versions of the rows of data
> > > > > > to sort this way.
> > > > > >
> > > > > > Thanks for any help.

It is probably a formula try this change

from
CopyRange.Copy _
Destination:=DestSht.Range("A" & DestRow)
to
CopyRange.Copy
DestSht.Range("A" & DestRow).PasteSpecial _
paste:=xlPasteValues


"Jeff Gross" wrote:

> Joel - thanks for all your help.
>
> The code works except for one thing. The Op # is being properly copied down
> for each row but the Op Description is not being properly copied. It copies
> directly from sheet1 b2 and b3 to sheet2 b2 and b3.
>
> Any ideas?
>
> Jeff
>
> "Joel" wrote:
>
> > Lets try putting the trim into the new code. I try a test a found a formula
> > that is returning nothing ("") two double quotes with no spaces will be
> > recognized with the following statment as being true.
> >
> > If .Cells(SourceRow, Colcount) <> "" Then
> >
> > It is not the formula that causing the problem but the value that is being
> > returned by the formula. Probably is returning a non-blank string. Using
> > trim will remove any blanks.
> >
> >
> > from
> > If .Cells(SourceRow, Colcount) <> "" Then
> > to
> > If Trim(.Cells(SourceRow, Colcount)) <> "" Then
> >
> >
> > "Jeff Gross" wrote:
> >
> > > You're right - the cells are not truely blank but have a formula. Would a
> > > paste special values only take care of that issue?
> > >
> > > "Joel" wrote:
> > >
> > > > I looked at your data and didn't realize the differences between the code I
> > > > provided and then posting I responded to yesterday. Try these imporvements
> > > >
> > > > Sub Transpose()
> > > >
> > > > Set SourceSht = Sheets("sheet1")
> > > > Set DestSht = Sheets("sheet2")
> > > > With DestSht
> > > > .Range("A1") = "Op #"
> > > > .Range("B1") = "OP Desc"
> > > > .Range("C1") = "Hazard"
> > > > End With
> > > >
> > > > With SourceSht
> > > > LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
> > > > SourceRow = 2
> > > > DestRow = 2
> > > > Do While .Range("A" & SourceRow) <> ""
> > > > 'set Copyrange to equal columns A - C
> > > > Set CopyRange = _
> > > > .Range("A" & SourceRow & ":B" & SourceRow)
> > > > For Colcount = 3 To LastCol
> > > > If .Cells(SourceRow, Colcount) <> "" Then
> > > > CopyRange.Copy _
> > > > Destination:=DestSht.Range("A" & DestRow)
> > > > Hazard = .Cells(SourceRow, Colcount).Value
> > > > DestSht.Range("C" & DestRow) = Hazard
> > > > DestRow = DestRow + 1
> > > > End If
> > > > Next Colcount
> > > > SourceRow = SourceRow + 1
> > > > Loop
> > > > End With
> > > > End Sub
> > > >
> > > >
> > > >
> > > >
> > > > "Jeff Gross" wrote:
> > > >
> > > > > Thanks alot Joel.
> > > > >
> > > > > I was actually looking at that post before posting my own. The code you
> > > > > provided is putting blank rows in when there is a blank in the cell of a
> > > > > particular column. I could do a subsequent re-sort and that would remove
> > > > > them but if I could just get the code to not put a blank row in when there is
> > > > > a blank cell, that would be very helpful.
> > > > >
> > > > > Jeff
> > > > >
> > > > > "Joel" wrote:
> > > > >
> > > > > > this is code I wrote yesterday for another posting. I modified yesterdays
> > > > > > code becasue you only have two columns that need to be copied to every row
> > > > > > and yesterdays posting had 3 columns that need to be copied to every row.
> > > > > > the code is copying the data from sheet1 and putting the results in sheet2.
> > > > > > The macro runs faster if you put the data into a new worksheet.
> > > > > >
> > > > > > Sub Transpose()
> > > > > >
> > > > > > Set SourceSht = Sheets("sheet1")
> > > > > > Set DestSht = Sheets("sheet2")
> > > > > > With DestSht
> > > > > > .Range("A1") = "ID"
> > > > > > .Range("B1") = "Surname"
> > > > > > .Range("C1") = "Name"
> > > > > > .Range("D1") = "Choises"
> > > > > > End With
> > > > > >
> > > > > > With SourceSht
> > > > > > SourceRow = 2
> > > > > > DestRow = 2
> > > > > > Do While .Range("A" & SourceRow) <> ""
> > > > > > 'set Copyrange to equal columns A - C
> > > > > > Set CopyRange = _
> > > > > > .Range("A" & SourceRow & ":B" & SourceRow)
> > > > > > ColCount = 3
> > > > > > Do While .Cells(SourceRow, ColCount) <> ""
> > > > > > CopyRange.Copy _
> > > > > > Destination:=DestSht.Range("A" & DestRow)
> > > > > > Choice = .Cells(SourceRow, ColCount).Value
> > > > > > DestSht.Range("C" & DestRow) = Choice
> > > > > > DestRow = DestRow + 1
> > > > > > ColCount = ColCount + 1
> > > > > > Loop
> > > > > > SourceRow = SourceRow + 1
> > > > > > Loop
> > > > > > End With
> > > > > > End Sub
> > > > > >
> > > > > >
> > > > > >
> > > > > >
> > > > > >
> > > > > > "Jeff Gross" wrote:
> > > > > >
> > > > > > > I have several columns of data such as follows:
> > > > > > >
> > > > > > > A B C D E
> > > > > > > Op # Op Desc Mechanical Electrical Fire
> > > > > > > 10 Desc #1 mech 1 elect 1
> > > > > > > 10 Desc #2 elect 2 fire 1
> > > > > > > 20 Desc #3 mech 2 fire 2
> > > > > > > 20 Desc #4 mech 3 elect 3
> > > > > > >
> > > > > > > The end result must be a sort of the data by Op # and then by the hazard
> > > > > > > category (columns C-E) with each hazard category on it's own row as follows:
> > > > > > >
> > > > > > > 10 Desc #1 mech 1
> > > > > > > 10 Desc #1 elect 1
> > > > > > > 10 Desc #2 elect 2
> > > > > > > 10 Desc #2 fire 1
> > > > > > > 20 Desc #3 mech 2
> > > > > > > 20 Desc #3 fire 2
> > > > > > > 20 Desc #4 mech 3
> > > > > > > 20 Desc #4 elect 3
> > > > > > >
> > > > > > > Any ideas? There could be up to 300 original versions of the rows of data
> > > > > > > to sort this way.
> > > > > > >
> > > > > > > Thanks for any help.