Copy Headings based on Cell Value

[Jeff Gross]

I have up to 300 rows of data with 11 columns on sheet "Data Sort 1". Column
A is filled based on some code running. Columns B-K may or may not have data
based on the fact that all of these cells have an IF formula.

What I need the data to do is search for data in the cell of each row. If
there is data, then enter the column heading on a different page ("Data Sort
1b"). The data would look like on the original sheet:

A B C D
E
Op # Op Desc Mech Risk Electr Risk Haz
Risk

10 test 1 elec 1
haz 1
10 test 2 mech 1
haz 2
10 test 3 mech 2 elec 2
10 test 4 elec 3


I need it to look like this on the second sheet in column C starting at row 2:

Electr Risk
Haz Risk
Mech Risk
Haz Risk
Mech Risk
Electr Risk
Electr Risk

Thanks for any help.

 

[Jeff Gross]

Here is the result I figured out:

Sheets("Data Sort 1b").Activate
With SourceSht
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
SourceRow = 2
DestRow = 2
SourceCol = 3
DestCol = 3
Do While .Range("A" & SourceRow) <> ""
For Colcount = 3 To LastCol
If Trim(.Cells(SourceRow, Colcount)) <> "" Then
HazardCategory = .Cells("1", Colcount).Value
DestSht.Range("C" & DestRow) = HazardCategory
DestRow = DestRow + 1
End If
Next Colcount
SourceRow = SourceRow + 1
Loop

Application.CutCopyMode = False
End With

 

[Patrick Molloy]

pretty good
1.you don't need
Application.CutCopyMode = False
2.ColumnsCount needs the decimal ie .ColumnsCount
3. the sheet doesn't even need to be the active sheet



With Sheets("Data Sort 1b")
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
SourceRow = 2
DestRow = 2
SourceCol = 3
DestCol = 3
Do While .Range("A" & SourceRow) <> ""
For Colcount = 3 To LastCol
If Trim(.Cells(SourceRow, Colcount)) <> "" Then
DestSht.Cells(DestRow,"C") = .Cells("1", Colcount).Value
DestRow = DestRow + 1
End If
Next Colcount
SourceRow = SourceRow + 1
Loop