Arrange Data Matrix into List for Access

R

ra

Hello,

Using Access for a number of calculation and have a lot of source data
in this format:

Name OCT NOV DEC
A 0 1 1
B 1 0.5 0
C 1 0 0
D 1 1 1


That I need to rearrange into this format:

A OCT 0
B OCT 1
C OCT 1
D OCT 1
A NOV 1
B NOV 0.5
C NOV 0
D NOV 1
A DEC 1
B DEC 0
C DEC 0
D DEC 1


I have some simple code for set ranges but ideally want to be able to
run one macro for differening number rows and columns.
Any help appreciated.
 
J

Joel

Try this code. It is generic. you should be able to modify as needed.


Sub main()
Dim Table As Range
Dim DestinationLoc As Range

With Sheets("Sheet1")
Set StartCell = .Range("A1")
LastCol = StartCell.End(xlToRight).Column
LastRow = StartCell.End(xlDown).Row
Set Table = .Range(StartCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = Sheets("Sheet2").Range("A1")
Call MakeRows(Table, DestinationLoc)

End Sub
Sub MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
NumRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To NumRows
'skip header column
For ColOffset = 2 To NumCols
Destination.Offset(NewRowOffset, 0) = Target(RowOffset, 1).Value
Destination.Offset(NewRowOffset, 1) = Target(1, ColOffset).Value
Destination.Offset(NewRowOffset, 2) = Target(RowOffset, ColOffset)
NewRowOffset = NewRowOffset + 1
Next ColOffset
Next RowOffset
End Sub
 
R

ra

Try this code.  It is generic.  you should be able to modify as needed.

Sub main()
Dim Table As Range
Dim DestinationLoc As Range

With Sheets("Sheet1")
   Set StartCell = .Range("A1")
   LastCol = StartCell.End(xlToRight).Column
   LastRow = StartCell.End(xlDown).Row
   Set Table = .Range(StartCell, .Cells(LastRow, LastCol))
End With
Set DestinationLoc = Sheets("Sheet2").Range("A1")
Call MakeRows(Table, DestinationLoc)

End Sub
Sub MakeRows(Target As Range, Destination As Range)

NumCols = Target.Columns.Count
NumRows = Target.Rows.Count
NewRowOffset = 0
'Skip header row
For RowOffset = 2 To NumRows
   'skip header column
   For ColOffset = 2 To NumCols
      Destination.Offset(NewRowOffset, 0) = Target(RowOffset, 1).Value
      Destination.Offset(NewRowOffset, 1) = Target(1, ColOffset).Value
      Destination.Offset(NewRowOffset, 2) = Target(RowOffset, ColOffset)
      NewRowOffset = NewRowOffset + 1
   Next ColOffset
Next RowOffset
End Sub










- Show quoted text -
Click to expand...

Excellent, very clever thanks
 
Top