Macro help

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

How can I set a marco to transfer data from a table format to a database format, for example
This is the table format
Jan-04 Paris Mila
Income 100 3
Rent -40 -

Like to become
Income Jan-04 Paris 10
Income Jan-04 Milan 3
Rent Jan-04 Paris -4
Rent Jan-04 Milan -

Thanks!!
 
Hi Jammy,

Here's some code

Sub MakeDB()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long, j As Long
Dim iTarget As Long
Dim shThis As Worksheet

Set shThis = ActiveSheet
Worksheets.Add
With shThis
cLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
cLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To cLastRow
For j = 2 To cLastCol
iTarget = iTarget + 1
ActiveSheet.Cells(iTarget, 1).Value = .Cells(i, 1).Value
ActiveSheet.Cells(iTarget, 2).Value = .Cells(1, 1).Value
ActiveSheet.Cells(iTarget, 3).Value = .Cells(1, j).Value
ActiveSheet.Cells(iTarget, 4).Value = .Cells(i, j).Value
Next j
Next i
End With
End Sub

Was the sample workbook man y good?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Bob

Thank you very much for your help. I 'm still working hard on it. It works!

Regards.
 
Thanks Bob
I'm still trying to work out the worksheet. But for the following macro, please help me to exclude subtotal or blank line when making the DB

Regards


----- Bob Phillips wrote: ----

Hi Jammy

Here's some cod

Sub MakeDB(
Dim cLastRow As Lon
Dim cLastCol As Lon
Dim i As Long, j As Lon
Dim iTarget As Lon
Dim shThis As Workshee

Set shThis = ActiveShee
Worksheets.Ad
With shThi
cLastRow = .Cells(Rows.Count, "A").End(xlUp).Ro
cLastCol = .Cells(1, Columns.Count).End(xlToLeft).Colum
For i = 2 To cLastRo
For j = 2 To cLastCo
iTarget = iTarget +
ActiveSheet.Cells(iTarget, 1).Value = .Cells(i, 1).Valu
ActiveSheet.Cells(iTarget, 2).Value = .Cells(1, 1).Valu
ActiveSheet.Cells(iTarget, 3).Value = .Cells(1, j).Valu
ActiveSheet.Cells(iTarget, 4).Value = .Cells(i, j).Valu
Next
Next
End Wit
End Su

Was the sample workbook man y good

--

HT

Bob Phillip
... looking out across Poole Harbour to the Purbeck
(remove nothere from the email address if mailing direct
 
Hi Jammy,

Try this

Sub MakeDB()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long, j As Long
Dim iTarget As Long
Dim shThis As Worksheet

Set shThis = ActiveSheet
Worksheets.Add.Name = "DB"
With shThis
cLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
cLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To cLastRow
If .Cells(i, "A") <> "" And Not .Cells(i, "A") Like "Total" Then
For j = 2 To cLastCol
iTarget = iTarget + 1
ActiveSheet.Cells(iTarget, 1).Value = .Cells(i, 1).Value
ActiveSheet.Cells(iTarget, 2).Value = .Cells(1, 1).Value
ActiveSheet.Cells(iTarget, 3).Value = .Cells(1, j).Value
ActiveSheet.Cells(iTarget, 4).Value = .Cells(i, j).Value
Next j
End If
Next i
End With
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Janmy said:
Thanks Bob,
I'm still trying to work out the worksheet. But for the following macro,
Click to expand...
please help me to exclude subtotal or blank line when making the DB.
 
Back
Top