Excel VBA Help Needed

  • Thread starter Thread starter Sammer52
  • Start date Start date
S

Sammer52

I am a new VBA Excel programmer and need some help with a project I am
working on.

I receive data in Excel files as shown below:

Received Date
Paid Date 1/03 2/03 3/03 4/03
1/03 $100 $0 $0 $0
2/03 $300 $150 $0 $0
3/03 $200 $350 $90 $0
4/03 $50 $200 $280 $110


I wanted to copy/convert this table into a format that is more easily
imported into Access:

Received Date Paid Date Amount
1/03 1/03 $100
1/03 2/03 $300
1/03 3/03 $200
1/03 4/03 $50
2/03 2/03 $150
2/03 3/03 $350
2/03 4/03 $200
3/03 3/03 $90
3/03 4/03 $280
4/03 4/03 $110

I'd like to program this automatically in VBA, but am stumped on how to
begin - or what the best approach might be.
 
This seemed to work ok for me:

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim DestCell As Range
Dim HowManyRows As Long
Dim HowManyCols As Long

Set CurWks = Worksheets("sheet1")
Set NewWks = Worksheets.Add

NewWks.Range("a1").Resize(1, 3).Value _
= Array("Received Date", "Paid Date", "Amount")
Set DestCell = NewWks.Range("A2")

With CurWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
HowManyRows = LastRow - FirstRow + 1
HowManyCols = LastCol - FirstCol + 1

For iCol = FirstCol To LastCol
'copy received dates into column A
.Cells(FirstRow - 1, FirstCol).Resize(1, HowManyCols).Copy
DestCell.PasteSpecial Transpose:=True

'copy paid dates into column B
.Cells(FirstRow, FirstCol - 1).Resize(HowManyRows, 1).Copy _
Destination:=DestCell.Offset(0, 1)

'copy amounts into column C
.Cells(FirstRow, iCol).Resize(HowManyRows, 1).Copy _
Destination:=DestCell.Offset(0, 2)

Set DestCell = DestCell.Offset(HowManyRows, 0)
Next iCol
End With

With NewWks
'sort the new worksheet
.Range("a:c").Sort _
key1:=.Columns(1), order1:=xlAscending, _
key2:=.Columns(2), order2:=xlAscending, _
header:=xlYes
End With

End Sub


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
Back
Top