VBA Programming

[Wild_Vivek]

Below is the header that i receive from the extract.
Header1 Header2 Header3 Header4 Header5 Header6(Blank) Header7
Header8 header9(Blank)Header10 Header11 Header12 Header13 Header14
Header15 Header16 Header17 Header18 Header19 Header20 Header21
header22 header 23 header24 header25 header26 header27 header28
12345 S XXXXX XXX ODB $1,234 (This data is for the first 7 Header)2222222 J xxxxx xxx $12,345.00 $12,345 10%(This data is for the Second 7 Header)
2014-09-08 022-1234-0000 xxx(123456) Y $0 $1,234 (This data is for the Third 7 Header)
2014-06-17 Complete MP $12,344.00 $100 2%(This data is for the fourth 7 Header)
12345 S XXXXX XXX ODB $1,234 (This data is for the first 7 Header)2222222 J xxxxx xxx $12,345.00 $12,345 10%(This data is for the Second 7 Header)
2014-09-08 022-1234-0000 xxx(123456) Y $0 $1,234 (This data is for the Third 7 Header)
2014-06-17 Complete MP $12,344.00 $100 2%(This data is for the fourth 7 Header)
...
....
....
...
...

This is how my data comes in. I got the header aligned using the below macro, but the data keeps getting deleted..


<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit; background-image: initial; background-attachment: initial; background-size: initial; background-origin: initial; background-clip: initial; background-position: initial; background-repeat: initial;">Sub AlignData() Dim i As Integer, j As Integer Dim rowCounter As Long, colCounter As Integer Dim lastRow As Long ' You can change the sheet number to the appropriate number starting from 1, ' or you can use the sheet's name in quotes e.g., Sheets("My_Sheet") ThisWorkbook.Sheets(1).Activate lastRow = ActiveSheet.UsedRange.Rows.Count ' This speeds things up but can it screw things up if the code glitches Application.ScreenUpdating = False Sheet1.EnableCalculation = False rowCounter = 1 colCounter = 1On Error GoTo Abort While lastRow > rowCounter For i = 1 To 5 If colCounter > 28 Then colCounter = 1 For j = 1 To 7 Cells(WorksheetFunction.Floor((rowCounter / 5) + 1, 1), colCounter) = Cells(rowCounter, j) colCounter = colCounter + 1 Next j rowCounter = rowCounter + 1 Next i WendAbort: Sheet1.EnableCalculation = True Application.ScreenUpdating = TrueEnd Sub</code></pre>
Please let me know if i am doing something wrong?

<colgroup><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[hiker95]

Wild_Vivek,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


When posting VBA code, please use Code Tags - like this:

[code=rich]

'Paste your code here.

[/code]



I am not able to determine what worksheet(s), cells, row, and, columns your text display data is in.


So that we can get it right on the first try:

Can you post a screenshot of the actual raw data worksheet?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post your data, you can download and install one of the following two programs:
1. MrExcel HTMLMaker20101230
https://onedrive.live.com/?cid=8cffdec0ce27e813&sc=documents&id=8CFFDEC0CE27E813!189

Installation instructions here:
http://www.mrexcel.com/forum/board-announcements/515787-forum-posting-guidelines.html#post2545970

2. Excel Jeanie
Download


If you are not able to give us screenshots:
You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[Wild_Vivek]

Thanks Hiker.

Here are the answers for the above question

1. What version of Excel and Windows are you using? 2010

2. Are you using a PC or a Mac? PC


When posting <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help;">VBA</acronym> code, please use Code Tags - like this:

[B]'Paste your code here.

[/B][/B][/B]
<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit; background-image: initial; background-attachment: initial; background-size: initial; background-origin: initial; background-clip: initial; background-position: initial; background-repeat: initial;">[COLOR=#00008B]Sub[/COLOR] AlignData()    [COLOR=#00008B]Dim[/COLOR] i [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Integer[/COLOR], j [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Integer[/COLOR]    [COLOR=#00008B]Dim[/COLOR] rowCounter [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Long[/COLOR], colCounter [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Integer[/COLOR]    [COLOR=#00008B]Dim[/COLOR] lastRow [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Long[/COLOR]    [COLOR=#808080]' You can change the sheet number to the appropriate number starting from 1,[/COLOR]    [COLOR=#808080]' or you can use the sheet's name in quotes e.g., Sheets("My_Sheet")[/COLOR]    ThisWorkbook.Sheets([COLOR=#800000]1[/COLOR]).Activate    lastRow = ActiveSheet.UsedRange.Rows.Count    [COLOR=#808080]' This speeds things up but can it screw things up if the code glitches[/COLOR]    Application.ScreenUpdating = [COLOR=#800000]False[/COLOR]    Sheet1.EnableCalculation = [COLOR=#800000]False[/COLOR]    rowCounter = [COLOR=#800000]1[/COLOR]    colCounter = [COLOR=#800000]1[/COLOR][COLOR=#00008B]On[/COLOR] [COLOR=#00008B]Error[/COLOR] [COLOR=#00008B]GoTo[/COLOR] Abort    [COLOR=#00008B]While[/COLOR] lastRow > rowCounter        [COLOR=#00008B]For[/COLOR] i = [COLOR=#800000]1[/COLOR] [COLOR=#00008B]To[/COLOR] [COLOR=#800000]4[/COLOR]            [COLOR=#00008B]If[/COLOR] colCounter > [COLOR=#800000]28[/COLOR] [COLOR=#00008B]Then[/COLOR] colCounter = [COLOR=#800000]1[/COLOR]            [COLOR=#00008B]For[/COLOR] j = [COLOR=#800000]1[/COLOR] [COLOR=#00008B]To[/COLOR] [COLOR=#800000]7[/COLOR]                Cells(WorksheetFunction.Floor((rowCounter / [COLOR=#800000]4[/COLOR]) + [COLOR=#800000]1[/COLOR], [COLOR=#800000]1[/COLOR]), colCounter) = Cells(rowCounter, j)                colCounter = colCounter + [COLOR=#800000]1[/COLOR]            [COLOR=#00008B]Next[/COLOR] j            rowCounter = rowCounter + [COLOR=#800000]1[/COLOR]        [COLOR=#00008B]Next[/COLOR] i    [COLOR=#00008B]Wend[/COLOR]Abort:    Sheet1.EnableCalculation = [COLOR=#800000]True[/COLOR]    Application.ScreenUpdating = [COLOR=#800000]True[/COLOR][COLOR=#00008B]End[/COLOR] [COLOR=#00008B]Sub[/COLOR]</code></pre>
here is the link for the file

https://app.box.com/s/ipuhw08kc5tdzsd9yzuj

Thanks
Vivek[/B]

 

[hiker95]

Wild_Vivek,

Thanks for the workbook.

I do have a macro that uses two arrays in memory (very fast), but, the formatting is not coming out correctly.

The following macro is based on the fact that your raw data is in groups of 4 rows.

Sample raw data in worksheet Raw_Data:

Excel 2007
	A	B	C	D	E	F	G
1	Header1	Header2	Header3	Header4	Header5	Header6(Blank)	Header7
2	Header8	header9(Blank)	Header10	Header11	Header12	Header13	Header14
3	Header15	Header16	Header17	Header18	Header19	Header20	Header21
4	header22	header 23	header24	header25	header26	header27	header28
5	12345	S	XXXXX	XXX	ODB		$1,234
6	2222222	J	xxxxx	xxx	$12,345.00	$12,345	10%
7	2014-09-08	022-1234-0000	xxx(123456)	Y		$0	$1,234
8	2014-06-17	Complete		MP	$12,344.00	$100	2%
9	12346	S	XXXXX	XXX	ODB		$1,234
10	2222222	J	xxxxx	xxx	$12,345.00	$12,345	10%
11	2014-09-08	022-1234-0000	xxx(123456)	Y		$0	$1,234
12	2014-06-17	Complete		MP	$12,344.00	$100	2%
13	12347	S	XXXXX	XXX	ODB		$1,234
14	2222222	J	xxxxx	xxx	$12,345.00	$12,345	10%
15	2014-09-08	022-1234-0000	xxx(123456)	Y		$0	$1,234
16	2014-06-17	Complete		MP	$12,344.00	$100	2%
17	12348	S	XXXXX	XXX	ODB		$1,234
18	2222222	J	xxxxx	xxx	$12,345.00	$12,345	10%
19	2014-09-08	022-1234-0000	xxx(123456)	Y		$0	$1,234
20	2014-06-17	Complete		MP	$12,344.00	$100	2%
21
Raw_Data

After the macro in a new worksheet Results:

Excel 2007
	A	B	C	D	E	F	G
1	Header1	Header2	Header3	Header4	Header5	Header6(Blank)	Header7
2	12345	S	XXXXX	XXX	ODB		$1,234
3	12346	S	XXXXX	XXX	ODB		$1,234
4	12347	S	XXXXX	XXX	ODB		$1,234
5	12348	S	XXXXX	XXX	ODB		$1,234
6
Results

Excel 2007
	H	I	J	K	L	M	N
1	Header8	header9(Blank)	Header10	Header11	Header12	Header13	Header14
2	2222222	J	xxxxx	xxx	$12,345.00	$12,345	10%
3	2222222	J	xxxxx	xxx	$12,345.00	$12,345	10%
4	2222222	J	xxxxx	xxx	$12,345.00	$12,345	10%
5	2222222	J	xxxxx	xxx	$12,345.00	$12,345	10%
6
Results

Excel 2007
	O	P	Q	R	S	T	U
1	Header15	Header16	Header17	Header18	Header19	Header20	Header21
2	2014-09-08	022-1234-0000	xxx(123456)	Y		$0	$1,234
3	2014-09-08	022-1234-0000	xxx(123456)	Y		$0	$1,234
4	2014-09-08	022-1234-0000	xxx(123456)	Y		$0	$1,234
5	2014-09-08	022-1234-0000	xxx(123456)	Y		$0	$1,234
6
Results

Excel 2007
	V	W	X	Y	Z	AA	AB
1	header22	header 23	header24	header25	header26	header27	header28
2	2014-06-17	Complete		MP	$12,344.00	$100	2%
3	2014-06-17	Complete		MP	$12,344.00	$100	2%
4	2014-06-17	Complete		MP	$12,344.00	$100	2%
5	2014-06-17	Complete		MP	$12,344.00	$100	2%
6
Results

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData()
' hiker95 09/16/2014, ME805834
Dim w1 As Worksheet, wr As Worksheet
Dim r As Long, lr As Long, nr As Long, lc As Long, nc As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Raw_Data")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Worksheets("Results")
wr.UsedRange.ClearContents
With w1
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, Columns.Count).End(xlToLeft).Column
  For r = 1 To lr Step 4
    nc = 1
    nr = wr.Cells(wr.Rows.Count, "A").End(xlUp).Row + 1
    If nr = 2 And wr.Cells(1, 1) = "" Then nr = 1
    .Range(.Cells(r, 1), .Cells(r, lc)).Copy Destination:=wr.Cells(nr, nc)
    nc = nc + lc
    .Range(.Cells(r + 1, 1), .Cells(r + 1, lc)).Copy Destination:=wr.Cells(nr, nc)
    nc = nc + lc
    .Range(.Cells(r + 2, 1), .Cells(r + 2, lc)).Copy Destination:=wr.Cells(nr, nc)
    nc = nc + lc
    .Range(.Cells(r + 3, 1), .Cells(r + 3, lc)).Copy Destination:=wr.Cells(nr, nc)
    Application.CutCopyMode = False
  Next r
End With
With wr
  .UsedRange.Columns.AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.

 

[Wild_Vivek]

Thanks a ton it works like a killer...

 

[hiker95]

Wild_Vivek,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.