Tabular to CSV style layout

[Michael Beckinsale]

Hi All,

I need to manipulate tabular data in an Excel file into a layout similar to
database style CSV layout for export to an external database.

The existing Excel layout is as follows:

Description Jan-05 Feb-05 Mar-05 etc
LAA001 10 20 30
LAA002 100 200 300

the data consists of approx 600 rows & 12 columns

I would like to create the following layout using VBA code (because l have
to apply x 3 in 53 workbooks!)

LAA001 Jan-05 10
LAA002 Jan-05 100
LAA001 Feb-05 20
LAA002 Feb-05 200
LAA001 Mar-05 30
LAA002 Mar-05 300

Does anybody have any code that can do this or very similar that l can adapt
please ! I have tried messing about with pivot tables but without success.

All suggestions gratefully received

Regards

Michael beckinsale

 

[keepITcool]

try s'thin like:
Sub Transformer()
Dim rSrc As Range
Dim rDst As Range
Dim vRes, r&, c&, n&, cData&, rData&

Set rSrc = Application.InputBox( _
"Input range incl. 1 header row", "SOURCE", _
Default:=ActiveWindow.RangeSelection.Address, Type:=8)

'resize input to avoid empty cells
Set rSrc = Range(rSrc.Cells(1), rSrc.Cells(Rows.Count, _
rSrc.Column).End(xlUp)).Resize(, rSrc.Columns.Count)
'for debugging.. select the range
rSrc.Select

rData = (rSrc.Rows.Count - 1) * (rSrc.Columns.Count - 1)
ReDim vRes(1 To rData, 1 To 3)
With rSrc
For r = 2 To .Rows.Count
For c = 2 To .Columns.Count
n = n + 1
vRes(n, 1) = .Cells(r, 1)
vRes(n, 2) = .Cells(1, c)
vRes(n, 3) = .Cells(r, c)
Next
Next
End With
Set rDst = Application.InputBox( _
"Select first cell of destination range", "DESTINATION", _
Type:=8)
rDst.Cells(1).Resize(rData, 3) = vRes

End Sub





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Michael Beckinsale wrote :

 

[Tom Ogilvy]

Existing data in Sheet1, new data to go to Sheet2.
The basic code would go something like this:

Sub AABB()
Dim rng As Range, base As Range, cell As Range
Dim kk As Long, j As Long, sh As Worksheet
Dim lastcol As Long
With Worksheets("Sheet1")
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
lastcol = .Cells(1, "IV").End(xlToLeft).Column
Set base = .Range("A1")
End With

kk = 1
Set sh = Worksheets("Sheet2")
For Each cell In rng
For j = 2 To lastcol
sh.Cells(kk, 1) = cell.Value
sh.Cells(kk, 2) = base(1, j).Value
sh.Cells(kk, 3) = base(cell.Row, j).Value
kk = kk + 1
Next j
Next cell
sh.UsedRange.Sort Key1:=sh.Range("B1"), _
Order1:=xlAscending, Key2:=sh.Range("A1"), _
Order2:=xlAscending, Header:=xlNo

End Sub

for proper sorting, this assumes the month headers on the first row are
actual dates values formatted to display as mmm-yy

 

[Michael Beckinsale]

Tom / KeepITcool,

Many thanks for the coding that you both sent, they work a treat and will
save me a lot of "head scratching"

Regards