Macro for Quick Formatting

muell595 · Aug 6, 2013

Good afternoon, everyone.

Could I get some help on writing a macro? Starting in R1C1, I am given the following from an external database following:

Name	List1	List2	List3	List4	List5	List6	List7
Useless Text	9483	37.4	4.3	19	23.7	12.5	3.7
Last, First	62	0.9	4.5	0	85.5	6.8	0.1
7/1/2013	2	1.1	5.5	0	93	0	0.3
07:00	0	0	0	0	100	0	0
07:15	0	0	0	0	100	0	0
07:30	0	0	0	0	100	0	0
07:45	0	0	0	0	100	0	0
08:00	0	0	0	0	100	0	0
08:15	0	0	0	0	100	0	0
08:30	0	0	0	0	100	0	0
08:45	0	0	0	0	100	0	0
09:00	0	0	15.1	0	84.8	0	0
09:15	0	0	0	0	100	0	0
7/2/2013	2		1.8		77.5	14.3
07:00	0	0	0	0	26.5	73.3	0
07:15	0	0	0	0	99.8	0.2	0
07:30	0	0	0	0	100	0	0
07:45	0	0	0	0	100	0	0
08:00	0	0	0	0	100	0	0
08:15	0	0	0	0	100	0	0
08:30	0	0	0	0	100	0	0
08:45	0	0	0	0	100	0	0
09:00	0	0	7.1	0	91.8	0	0
09:15	0	0	0	0	100	0	0
Last2,First2	3		2	2.3	86	14
07:00	0	0	0	0	100	0	0
07:15	0	0	0	0	99.9	0.1	0
07:30	0	0	0	0	100	0	0
07:45	1	0	0	0	98.1	0	0
08:00	0	0	0	0	100	0	0
08:15	0	0	0	0	100	0	0
08:30	0	0	0	0	100	0	0
08:45	0	0	0	0	100	0	0
09:00	0	0	4	0	94.3	0	0
09:15	0	0	2.6	0	97.4	0	0
09:30	0	0	0	0	100	0	0

I would like it to look more like the following below. Considering the actual list is hundreds of times longer than this, a macro would be nice. The colored texts in the tables above and below are actually filled with that color with black text. Essentially I would like to have the name added in a separate column left of the time, and get rid of all the crap cells to mimic this table:

Name	Time	List1	List 2	List3	List 4	List 5	List 6	List 7
Last, First 7/1/2013	07:00					100
Last, First 7/1/2013	07:15					100
Last, First 7/1/2013	07:30					100
Last, First 7/1/2013	07:45					100
Last, First 7/1/2013	08:00					100
Last, First 7/1/2013	08:15					100
Last, First 7/1/2013	08:30					100
Last, First 7/1/2013	08:45					100
Last, First 7/1/2013	09:00			15.1		84.8
Last, First 7/1/2013	09:15					100
Last, First 7/2/2013	07:00					26.5	73.3
Last, First 7/2/2013	07:15					99.8	0.2
Last, First 7/2/2013	07:30					100
Last, First 7/2/2013	07:45					100
Last, First 7/2/2013	08:00					100
Last, First 7/2/2013	08:15					100
Last, First 7/2/2013	08:30					100
Last, First 7/2/2013	08:45					100
Last, First 7/2/2013	09:00			7.1		91.8
Last, First 7/2/2013	09:15					100
Last2,First2 7/1/2013	07:00					100
Last2,First2 7/1/2013	07:15					99.9	0.1
Last2,First2 7/1/2013	07:30					100
Last2,First2 7/1/2013	07:45	1				98.1
Last2,First2 7/1/2013	08:00					100
Last2,First2 7/1/2013	08:15					100
Last2,First2 7/1/2013	08:30					100
Last2,First2 7/1/2013	08:45					100
Last2,First2 7/1/2013	09:00			4		94.3
Last2,First2 7/1/2013	09:15			2.6		97.4

I don't even care about the fill or anything of the like either. Is there someone out there willing to be a hero today and help me? It would be greatly appreciated!

sijpie · Aug 9, 2013

How do I know that the first entries for Last2,First2 are starting on 7/1/2013? In the macro below I have assumed a new section (unless immediately followed by date) will start at the very first date in the list.

I also do not know if the dates and times are imported as text or as numbers, so i have taken both options into account.

Because we work totally in memory, only one read from the sheet, and one write to the sheet, the macro is very fast

Enjoy.

Option Explicit Sub ResortList() Dim rOut As Range Dim aIn As Variant, aOut As Variant Dim lRin As Long, lRout As Long Dim i As Integer Dim sSect As String, sDate As String 'We are going to do all the rehashing of _ first two columns and deleting of zeros _ in memory, rather than looping on the sheet. _ For this we work with two arrays, aIn and aOut 'fill aIn array with the input data table aIn = Cells(1, 1).CurrentRegion 'the array is now just like a sheet with _ 'rows' and 'columns'. Now we need to size _ the output array to be same number of rows _ and one column wider. In fact it will give _ us few too many rows, but that doesn't matter ReDim aOut(1 To UBound(aIn, 1), 1 To UBound(aIn, 2) + 1) 'Set title row For i = 2 To UBound(aIn, 2) aOut(1, i + 1) = aIn(1, i) Next i aOut(1, 1) = aIn(1, 1) aOut(1, 2) = "Time" lRout = 2 'now process rest of aIn. Start on row 3 For lRin = 3 To UBound(aIn, 1) Select Case True Case Left(aIn(lRin, 1), 4) = "Last" 'signals 'new section' sSect = aIn(lRin, 1) aOut(lRout, 1) = sSect & " - " & sDate Case Mid(aIn(lRin, 1), 3, 1) = "/", _ IsDate(aIn(lRin, 1)) 'signals new date 'if first date, store for start _ new sections 'in above case i check for both numerical _ date as for text date format If sDate = vbNullString Then If IsDate(aIn(lRin, 1)) Then sDate = Format(aIn(lRin, 1), "MM/D/YYYY") Else sDate = aIn(lRin, 1) End If End If 'Put section & date in first column aOut(lRout, 1) = sSect & " - " & aIn(lRin, 1) Case Mid(aIn(lRin, 1), 3, 1) = ":", IsNumeric(aIn(lRin, 1)) ' signals a time. copy List columns 'case accounts for both text time as for _ numerical time (fraction) For i = 2 To UBound(aOut, 2) If aIn(lRin, i - 1) <> 0 Then aOut(lRout, i) = aIn(lRin, i - 1) End If Next i If aOut(lRout, 1) = vbNullString Then 'copy 'cell' above aOut(lRout, 1) = aOut(lRout - 1, 1) End If lRout = lRout + 1 End Select Next lRin 'output array to new sheet Sheets.Add after:=ActiveSheet ' ActiveSheet.Name = "List" Set rOut = Cells(1, 1) 'set to A1 'write data from aOut to range sized to same size rOut.Resize(UBound(aOut, 1), UBound(aOut, 2)).Value = aOut Columns(1).EntireColumn.AutoFit Columns(2).EntireColumn.NumberFormat = "HH:MM" 'clean up Set rOut = Nothing End Sub

muell595 · Aug 13, 2013

I have a feeling this is going to work extremely well, but I am now getting an error with the number of arguments for line:
sDate = Format(aIn(lRin, 1), "MM/D/YYYY")

Is that becasue it's the wrong format? Honestly, it'll take me some time to wrap my head around this beautiful piece of work you wrote, so at this moment I'm sitting here with my head sideways, drooling. Do you know the quick answer for this one?

The dates and times are all imported as text/"General." I have a feeling that's they key here, but I don't really know for sure.

sijpie · Aug 14, 2013

Mmhh, although the format should be "MM/DD/YYYY" in your case this should not a difference

I suggest you do a bit of debugging: open the vba editor, go to the macro and click in the border left of this line. A red dot should appear and the line should turn red. You have set a breakpoint, the code will stop here every time it runs. So run the macro. The editor will show with the red line marked yellow. Hold your mouse over the aIn(lRin,1). It should show you the date. Press F8 key to execute the next step. If it executes without an error, then press F5 to continue run the code. It will stop at the same line again. Do this until it gives the error. What is the value of aIn(lRin,1) ?

I do not have access to Excel at the moment, and so can't check, but possibly the format function can't operate if the date is text and not a value. I will then have to rethink how to modify this piece of code.

but let me know the results of the debugging.

Macro for Quick Formatting

muell595

New Member

Excel Facts

sijpie

Well-known Member

muell595

New Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

Macro for Quick Formatting

muell595

New Member

Excel Facts

sijpie

Well-known Member

muell595

New Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock