View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Patrick Molloy Patrick Molloy is offline
external usenet poster
 
Posts: 1,049
Default Copy Headings based on Cell Value

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



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

"Jeff Gross" wrote:

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.