Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

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

Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

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.

Combine and Convert to Multiple Rows
 

That was it - thanks alot for your help.

Jeff

"Joel" wrote:

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.

Combine and Convert to Multiple Rows
 

Hi Joel-

I opened the file this morning and when I run the code, I keep getting a
compile error. Any ideas?

The exact error is: Compile error: Expected Function or variable

Thanks.

Jeff

"Joel" wrote:

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.

Combine and Convert to Multiple Rows
 

Joel - please disregard the post I just made - I had added some code and
didn't realize I had named it the same as in this code. Once I removed it,
it worked again.

Jeff

"Jeff Gross" wrote:

Hi Joel-

I opened the file this morning and when I run the code, I keep getting a
compile error. Any ideas?

The exact error is: Compile error: Expected Function or variable

Thanks.

Jeff

"Joel" wrote:

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.