VBA to transpose dataset and add a piece of data

wholly

New Member
Joined
Feb 18, 2013
Messages
16
Need to write vba code to sort of transpose from a horizontal data set to a vertical data set with an extra piece of data created.

If the table 1 has no data for mon -> sun just skip

Is there an easy way.. I just seem to be way our of my depth here!!

This data set has like 10,000 centres, so doing it by hand will take forever!!!

Thanks in advance



TABLE 1 - Original

[TABLE="width: 1000"]
<colgroup><col><col span="2"><col><col span="10"></colgroup><tbody>[TR]
[TD]ServiceApprovalNumber[/TD]
[TD]RatingsIssued[/TD]
[TD]Last Service Approval Transfer Date[/TD]
[TD]Annual Monday Start Time[/TD]
[TD]Annual Monday End Time[/TD]
[TD]Annual Tuesday Start Time[/TD]
[TD]Annual Tuesday End Time[/TD]
[TD]Annual Wednesday Start Time[/TD]
[TD]Annual Wednesday End Time[/TD]
[TD]Annual Thursday Start Time[/TD]
[TD]Annual Thursday End Time[/TD]
[TD]Annual Friday Start Time[/TD]
[TD]Annual Friday End Time[/TD]
[TD]listing_id[/TD]
[/TR]
[TR]
[TD]SE-00009863[/TD]
[TD="align: right"]Jul-16[/TD]
[TD="align: center"]########[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD="align: right"]155[/TD]
[/TR]
[TR]
[TD]SE-00009865[/TD]
[TD="align: right"]Jun-14[/TD]
[TD="align: center"]########[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD="align: right"]255[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]New Sheet - TABLE 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ServiceApprovalNumber [/TD]
[TD]listing_id[/TD]
[TD]day[/TD]
[TD]open_time [/TD]
[TD="colspan: 2"]close_time[/TD]
[TD][/TD]
[TD="colspan: 2"]where day[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009863[/TD]
[TD="align: right"]155[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]0 = Monday[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009864[/TD]
[TD="align: right"]155[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]1 = Tuesday[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009865[/TD]
[TD="align: right"]155[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]2 = Wednesday[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009866[/TD]
[TD="align: right"]155[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009867[/TD]
[TD="align: right"]155[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]6:30[/TD]
[TD="align: right"]18:30[/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"]skip if no hours data[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009865[/TD]
[TD="align: right"]255[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009866[/TD]
[TD="align: right"]255[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009867[/TD]
[TD="align: right"]255[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009868[/TD]
[TD="align: right"]255[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SE-00009869[/TD]
[TD="align: right"]255[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]7.45[/TD]
[TD="align: right"]17.45[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
BTW.. I am using your 1st script as all the numbers within the code are time formatted.

Please use the code in Post #3 .

Please re-state what you're trying to say in post #'s 11,12 and 13. It's not at all clear to me.
 
Upvote 0
sorry for the delay Tonyyy

1. Updated script to Post#3

Error message is Runtime Error 9, subscript out of range

Posted pics below

Images not showing??? dont know why!

links are www.sweetsorella.com/excel1.jpg
www.sweetsorella.com/excel2.jpg

arr2(i, 1) = subscript out of range

thanks wayne

excel1.jpg

excel2.jpg
excel1.jpg
 
Last edited:
Upvote 0
Try replacing this line...

Code:
arr1 = Sheets(1).UsedRange

with...

Code:
arr1 = Sheets("Sheet1").UsedRange.Value
And as before, replace "Sheet1" with your own worksheet name.

And if you want a little better performance from the code, add the following line just below the Dim statements...

Code:
Application.ScreenUpdating = False
 
Upvote 0
Tonyyy

You bloody legend!!!!

Thank YOU!!!!

It works perfectly

Thanks you for your continual updates in helping me...

wayne
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

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