Excel Macro / Formula Helo

Sampath17

New Member
Joined
Apr 13, 2012
Messages
33
Hi

I am very new to excel macros

I am working with a spreadsheet that looks like this

-- removed inline image ---

Is there a Macro / Formula that could do this?

Thanks for your help.

S
 
Last edited:

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
How do I attach a sample file here??

Currently the sheet looks like this

<table width="256" border="0" cellpadding="0" cellspacing="0"><colgroup><col style="width:48pt" span="4" width="64"> </colgroup><tbody><tr style="height:16.5pt" height="22"> <td style="height:16.5pt;width:48pt" width="64" height="22">
</td> <td style="width:48pt" width="64">Apples</td> <td style="width:48pt" width="64">Oranges</td> <td style="width:48pt" width="64">Peaches</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Jan</td> <td align="right">10</td> <td align="right">20</td> <td align="right">30</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Feb</td> <td align="right">20</td> <td align="right">40</td> <td align="right">60</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Mar</td> <td align="right">30</td> <td align="right">60</td> <td align="right">90</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Apr</td> <td align="right">40</td> <td align="right">80</td> <td align="right">120</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">May</td> <td align="right">50</td> <td align="right">100</td> <td align="right">150</td> </tr> </tbody></table>
I would like to have it like this

<table width="192" border="0" cellpadding="0" cellspacing="0"><colgroup><col style="width:48pt" span="3" width="64"> </colgroup><tbody><tr style="height:16.5pt" height="22"> <td style="height:16.5pt;width:48pt" width="64" height="22">Jan</td> <td style="width:48pt" width="64">Apples</td> <td style="width:48pt" width="64" align="right">10</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Feb</td> <td>Apples</td> <td align="right">20</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Mar</td> <td>Apples</td> <td align="right">30</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Apr</td> <td>Apples</td> <td align="right">40</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">May</td> <td>Apples</td> <td align="right">50</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Jan</td> <td>Oranges</td> <td align="right">20</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Feb</td> <td>Oranges</td> <td align="right">40</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Mar</td> <td>Oranges</td> <td align="right">60</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Apr</td> <td>Oranges</td> <td align="right">80</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">May</td> <td>Oranges</td> <td align="right">100</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Jan</td> <td>Peaches</td> <td align="right">30</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Feb</td> <td>Peaches</td> <td align="right">60</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Mar</td> <td>Peaches</td> <td align="right">90</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">Apr</td> <td>Peaches</td> <td align="right">120</td> </tr> <tr style="height:16.5pt" height="22"> <td style="height:16.5pt" height="22">May</td> <td>Peaches</td> <td align="right">150</td> </tr> </tbody></table>
 
Upvote 0
Why do you want to convert it like that?
Seems to me that the existing layout is more friendly and useable.


You can't attach files here..
You have to use one of the tools suggested by Joe4.


You can copy paste direct from Excel, it appears that's what you did.
You can put borders around the data in Excel to make it look even nicer..
 
Upvote 0
I have to import this into Access... and information in Row 1 & Column A are reporting dimensions.

Also there are other mappings that i would need to do with the information before I re-publish it.
 
Last edited:
Upvote 0
Assuming that table is in the top left corner of the sheet...
The first Jan is in A2
And Apples is in B1

This will output the data to a different designated sheet.

Rich (BB code):
Sub test()
Dim ssht As Worksheet, dsht As Worksheet
Dim LC As Long, LR As Long, MyCol As Long, MyRow As Long
 
Set ssht = Sheets("Sheet1") '<-Sheet containing the data
Set dsht = Sheets("Sheet2") '<-Available empty sheet to put the new layout.
 
LC = ssht.Cells(1, Columns.Count).End(xlToLeft).Column
LR = ssht.Cells(Rows.Count, "A").End(xlUp).Row
 
dsht.Cells(1, 1) = "Month"
dsht.Cells(1, 2) = "Type"
dsht.Cells(1, 3) = "Count"
 
For MyCol = 2 To LC
    For MyRow = 2 To LR
        dsht.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = ssht.Cells(MyRow, 1)
        dsht.Cells(Rows.Count, "B").End(xlUp).Offset(1).Value = ssht.Cells(1, MyCol)
        dsht.Cells(Rows.Count, "C").End(xlUp).Offset(1).Value = ssht.Cells(MyRow, MyCol)
    Next MyRow
Next MyCol
End Sub
 
Upvote 0
This worked really good.. had to make a tweak to it... sometimes the values might be empty ... if Apples - Jan is blank... the values shift

Sub test()
Dim ssht As Worksheet, dsht As Worksheet
Dim LC As Long, LR As Long, MyCol As Long, MyRow As Long

Set ssht = Sheets("ICCos") '<-Sheet containing the data
Set dsht = Sheets("Sheet3") '<-Available empty sheet to put the new layout.

LC = ssht.Cells(1, Columns.Count).End(xlToLeft).Column
LR = ssht.Cells(Rows.Count, "A").End(xlUp).Row
'MsgBox LR
'MsgBox LC
dsht.Cells(1, 1) = "Month"
dsht.Cells(1, 2) = "Type"
dsht.Cells(1, 3) = "Count"

For MyCol = 2 To LC
For MyRow = 2 To LR
'dsht.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = ssht.Cells(MyRow, 1)
'MsgBox ssht.Cells(MyRow, 1)
'dsht.Cells(Rows.Count, "B").End(xlUp).Offset(1).Value = ssht.Cells(1, MyCol)
'MsgBox ssht.Cells(1, MyCol)
'dsht.Cells(Rows.Count, "C").End(xlUp).Offset(1).Value = ssht.Cells(MyRow, MyCol)
dsht.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = ssht.Cells(MyRow, 1)
MsgBox ssht.Cells(MyRow, 1)
dsht.Cells(Rows.Count, "B").End(xlUp).Offset(1).Value = ssht.Cells(1, MyCol)
MsgBox ssht.Cells(1, MyCol)
If IsEmpty(ssht.Cells(MyRow, MyCol)) = True Then
dsht.Cells(Rows.Count, "C").End(xlUp).Offset(1).Value = 0
Else
dsht.Cells(Rows.Count, "C").End(xlUp).Offset(1).Value = ssht.Cells(MyRow, MyCol)
End If

Next MyRow
Next MyCol
End Sub

The condition i added is in red... is that a good one or is there a better way you can think of...

Your solution is perfect..

The other thing I noticed is if I have a large number of columns (my actual data has about 150 columns) and rows (about 30 rows), the macro takes a very long time to execute. Anything you can suggest?

Thanks much for your help.

S
 
Upvote 0
If the correction you made works, don't fix it...:cool:

As far as making it faster, add this

At the beginning of the code

Code:
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Then at the very end

Code:
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
 
Upvote 0
Even after putting that in... it still took about 10 mins to come back... so i tried another way... Evaluate the value empty rightaway and it seemed to do the trick... comes back in 15-20 seconds now...

I also put in a command to clear contents in the destination worksheet before repopulating it...

Looking for your opinion... this being my first attempt and all :)


Sub ICCostofSales()
Dim ssht As Worksheet, dsht As Worksheet
Dim LC As Long, LR As Long, MyCol As Long, MyRow As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Set ssht = Sheets("ICCosSrc") '<-Sheet containing the source data
Set dsht = Sheets("ICCosDest") '<-Available empty sheet to put the new layout.

Sheets("ICCosDest").Activate
dsht.UsedRange.ClearContents


LC = ssht.Cells(1, Columns.Count).End(xlToLeft).Column
LR = ssht.Cells(Rows.Count, "A").End(xlUp).Row
dsht.Cells(1, 1) = "ICEntityCode"
dsht.Cells(1, 2) = "ProfitCenter"
dsht.Cells(1, 3) = "CostOfSales"

For MyCol = 2 To LC
For MyRow = 2 To LR
If IsEmpty(ssht.Cells(MyRow, MyCol)) = False Then

dsht.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = ssht.Cells(MyRow, 1)
dsht.Cells(Rows.Count, "B").End(xlUp).Offset(1).Value = ssht.Cells(1, MyCol)
If IsEmpty(ssht.Cells(MyRow, MyCol)) = True Then
dsht.Cells(Rows.Count, "C").End(xlUp).Offset(1).Value = 0
Else
dsht.Cells(Rows.Count, "C").End(xlUp).Offset(1).Value = ssht.Cells(MyRow, MyCol)
End If

End If

Next MyRow
Next MyCol

With Application
.Calculation = xlCalculationAutomatic
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,895
Messages
6,175,257
Members
452,625
Latest member
saadat28

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top