How do you turn a grid into columns?

[Henry Stock]

I have a grid I need to turn into a columnar list. I can't get the syntax
right.

Across the top are a list of items called controls. Down the left side are
items called risks. At the grid intersections are the letter P or D that
refer to a property of the controls. Controls are not necessarily
associated with every risk, so there also blank cells at some intersections.

I wanted to use nested for each loops, but I am not sure how to reference
the cells

for each i in controls
for each j in risks
'check the cell at the row column intersection of j,i
' if the cell is not blank then copy the risk and the control to a
columnar list. copy the value of cell(j,i) to a third column
' need to figure out how to increment the list rows
next
next

 

[Guest]

Henry,

HTH

Sub ColumnData()
Dim orng As Range
Dim r As Long, c As Integer
Dim lastrow As Long, lastcol As Integer
' find last column in row 1
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
' find lastrow in column A
lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Set ws1 = Worksheets("Sheet1") ' input data
Set ws2 = Worksheets("Sheet2") ' output data
Set orng = ws2.Range("a2")
ws1.Activate
With ws1
For c = 2 To lastcol ' Controls
For r = 2 To lastrow ' Risks
If .Cells(r, c) <> "" Then
orng = .Cells(r, "A") ' Risk
orng.Offset(0, 1) = .Cells(1, c) ' Control
orng.Offset(0, 2) = .Cells(r, c) ' Value (P or D)
Set orng = orng.Offset(1, 0)
End If
Next r
Next c
End With
End Sub

 

[Guest]

Correction!

Sub ColumnData()
Dim orng As Range
Dim r As Long, c As Integer
Dim lastrow As Long, lastcol As Integer

Set ws1 = Worksheets("Sheet1") ' input data
Set ws2 = Worksheets("Sheet2") ' output data

Set orng = ws2.Range("a2")
ws1.Activate
' find last column in row 1
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
' find lastrow in column A
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
With ws1
For c = 2 To lastcol
For r = 2 To lastrow
If .Cells(r, c) <> "" Then
orng = .Cells(r, "A") ' Risk
orng.Offset(0, 1) = .Cells(1, c) ' Control
orng.Offset(0, 2) = .Cells(r, c) ' Value (P or D)
Set orng = orng.Offset(1, 0)
End If
Next r
Next c
End With
End Sub

 

[Leith Ross]

Hello Henry,

Its not difficult once you know how to do it. In this example the gri
is the Range $A$1:$D$5. It is then placed into three columns G, H, an
I. You would need to change the variable names to suite your progra
and also add the Blank Cell check (after the End With statement) t
prevent blanks from appearing in the columns.


Code
-------------------

Sub GridToColumns()

Dim Rng As Excel.Range
Dim N As Long
Dim C, R, V

Set Rng = Range("A15")
N = Rng.Cells.Count

For I = 1 To N
With Rng
C = .Item(I).Column
R = .Item(I).Row
V = .Item(I).Value
End With
Cells(I, "G").Value = C
Cells(I, "H").Value = R
Cells(I, "I").Value = V
Next I

End Sub

 

[Leith Ross]

Hello Henry,

Its not difficult once you know how to do it. In this example the gri
is the Range $A$1:$D$5. It is then placed into three columns G, H, an
I. You would need to change the variable names to suite your progra
and also add the Blank Cell check (after the End With statement) t
prevent blanks from appearing in the columns.


Code
-------------------

Sub GridToColumns()

Dim Rng As Excel.Range
Dim N As Long
Dim C, R, V

Set Rng = Range("A15")
N = Rng.Cells.Count

For I = 1 To N
With Rng
C = .Item(I).Column
R = .Item(I).Row
V = .Item(I).Value
End With
Cells(I, "G").Value = C
Cells(I, "H").Value = R
Cells(I, "I").Value = V
Next I

End Sub