Arranging data in a spreadsheet using VBA

A

ashukla1

New Member
Joined
Oct 31, 2017
Messages
7
I Have a data in aspreadsheet that is spread horizantally see below.

Name
Date
ID
Description
BaseFees
Total
Description
Base
Fees
Total
Description
Base
Fees
TotalDescriptionBase
Fees
Total
John
11/2/2017123456Abc101020DEF202010JKL3030
60
XYZ
101020
Jane11/1/2017654321Abc101020DEF202010JKL303060

<colgroup><col style="width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:2486;width:51pt" width="68"> <col style="width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:2852;width:59pt" width="78"> <col style="width:48pt" width="64" span="3"> <col style="mso-width-source:userset;mso-width-alt:2852;width:59pt" width="78"> <col style="mso-width-source:userset;mso-width-alt:3913;width:80pt" width="107"> <col style="width:48pt" width="64" span="2"> <col style="mso-width-source:userset;mso-width-alt:2852;width:59pt" width="78"> <col style="width:48pt" width="64" span="7"> </colgroup><tbody>
</tbody>


I need this data to be arranged Vertically see example below.

Name
DateIDDescriptionBaseFees Total
John11/2/2017123456Abc101020
John11/2/2017123456DEF202010
John11/2/2017123456JKL303060
John11/2/2017123456XYZ101020
Jane11/1/2017654321Abc101020
Jane11/1/2017654321Abc101020
Jane11/1/2017654321DEF202010
Jane11/1/2017654321JKL303060

<colgroup><col><col><col><col><col span="3"></colgroup><tbody>
</tbody>


any help with this will be appreciated i have been trying to move this for days but no success.

to do this using a formula is a very long procedure and i have to do this every day.

Please Help:)
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
Re: Help With Arranging data in a spreadsheet using VBA

Welcome to the board.

What is the name of the sheet the data is on?
What is the range address the data is in?
What cell do you want the re-arranged data to start in? If it's not the same sheet, please provide sheet name also.
 
Upvote 0
Re: Help With Arranging data in a spreadsheet using VBA

JackDanIce said:
Welcome to the board.

What is the name of the sheet the data is on?
What is the range address the data is in?
What cell do you want the re-arranged data to start in? If it's not the same sheet, please provide sheet name also.
Click to expand...



Hi JackDanice.


Thank you so much for replying
Data range is A1:DJ2380
My Data is on Sheet 1
I need the data rearranged in sheet 2
 
Upvote 0
Re: Help With Arranging data in a spreadsheet using VBA

Try this:-
NB:- To get sets of 4
DescriptionBaseFees Total

<tbody>
</tbody>
from column "D" on, you would need to have your last column as "DK" not "DJ".
On that basis this code should work.
Results on Sheet2.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG02Nov58
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Cells(1).CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * Int(UBound(Ray, 2) / 4), 1 To 7)
nray(1, 1) = "Name": nray(1, 2) = "Date": nray(1, 3) = "ID": nray(1, 4) = "Description"
nray(1, 5) = "Base": nray(1, 5) = "Fees": nray(1, 7) = "Total"
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 4 To UBound(Ray, 2) [COLOR="Navy"]Step[/COLOR] 4
      [COLOR="Navy"]If[/COLOR] Ray(n, Ac) <> "" [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            nray(c, 1) = Ray(n, 1)
            nray(c, 2) = Ray(n, 2)
            nray(c, 3) = Ray(n, 3)
            nray(c, 4) = Ray(n, Ac)
            nray(c, 5) = Ray(n, Ac + 1)
            nray(c, 6) = Ray(n, Ac + 2)
            nray(c, 7) = Ray(n, Ac + 3)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 7)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Re: Help With Arranging data in a spreadsheet using VBA

Hi Mick,

this did work great except that when i tried to add a few more columns to it it did not work.
i still need the keep moving the last four cells but i have added few more columns before them.
below is the code i used.
i am getting an error Subscript out of range.

Below is my data.

Date
Report TypeApplicant IDApplicant NamePackage NameReference CodeBilling CodeLocationRun ByBaseFeesTotalComponent 1Component 1 BaseComponent 1 FeeComponent 1 TotalComponent 2Component 2 BaseComponent 2 FeeComponent 2 TotalComponent 3Component 3 BaseComponent 3 FeeComponent 3 TotalComponent 4Component 4 BaseComponent 4 FeeComponent 4 TotalComponent 5Component 5 BaseComponent 5 FeeComponent 5 TotalComponent 6Component 6 BaseComponent 6 FeeComponent 6 TotalComponent 7Component 7 BaseComponent 7 FeeComponent 7 Total
5/9/2017 17:53Applicant Report105528354Joshua Napoleon RandlePackage 1: Pre Hire Full BGC SGB - Shiftgig Bullpen, Inc.Milwaukeedsherman@shiftgig.com$19.25$0.00$19.25SSN Trace$1.25$0.00$1.25Client Criteria$1.00$0.00$1.00Multi-State Instant Criminal Check$3.00$0.00$3.00Criminal Check by Jurisdiction - State: WI, County: Milwaukee$14.00$0.00$14.00Nationwide Sex Offender Registry Check$0.00$0.00$0.00Criminal Check by County - State: VA, County: Smyth$0.00$0.00$0.00
5/15/2017 15:40Applicant Report105883938Harmony Edwinta LewisPackage 1: Pre Hire Full BGC SGB - Shiftgig Bullpen, Inc.Memphisjhashmi@shiftgig.com$19.25$0.00$19.25SSN Trace$1.25$0.00$1.25Client Criteria$1.00$0.00$1.00Multi-State Instant Criminal Check$3.00$0.00$3.00Criminal Check by Jurisdiction - State: TN, County: Shelby$14.00$0.00$14.00Nationwide Sex Offender Registry Check$0.00$0.00$0.00Criminal Check by County - State: VA, County: Smyth$0.00$0.00$0.00
5/22/2017 4:21Applicant Report106297852Jose Israel GarciaPackage 1: Pre Hire Full BGC SGB - Shiftgig Bullpen, Inc.Nashvilleawigand@shiftgig.com$19.25$0.00$19.25SSN Trace$1.25$0.00$1.25Client Criteria$1.00$0.00$1.00Multi-State Instant Criminal Check$3.00$0.00$3.00Criminal Check by Jurisdiction - State: TN, County: Rutherford$14.00$0.00$14.00Nationwide Sex Offender Registry Check$0.00$0.00$0.00Criminal Check by County - State: FL$0.00$0.00$0.00Criminal Check by County - State: NC$0.00$0.00$0.00
5/24/2017 16:57
Applicant Report106550443Harold Julius BrownPackage 1: Pre Hire Full BGC SGB - Shiftgig Bullpen, Inc.Phoenix
jruiz@shiftgig.com$19.25$0.00$19.25SSN Trace$1.25$0.00$1.25Client Criteria$1.00$0.00$1.00Multi-State Instant Criminal Check$3.00$0.00$3.00Criminal Check by Jurisdiction - State: AZ, County: Maricopa$14.00$0.00$14.00Nationwide Sex Offender Registry Check$0.00$0.00$0.00Criminal Check by County - State: VA, County: Henrico$0.00$0.00$0.00
6/14/2017 1:40Applicant Report107937037Trayvione Lamarque LeonardPackage 1: Pre Hire Full BGCSGB - Shiftgig Bullpen, Inc.Houstonpaige.kilchrist@shiftgig.com$19.25$0.00$19.25SSN Trace$1.25$0.00$1.25Client Criteria$1.00$0.00$1.00Multi-State Instant Criminal Check$3.00$0.00$3.00Criminal Check by Jurisdiction - State: TX, County: Harris$14.00$0.00$14.00Nationwide Sex Offender Registry Check$0.00$0.00$0.00Criminal Check by County - State: VA$0.00$0.00$0.00

<colgroup><col><col><col><col span="4"><col><col span="32"></colgroup><tbody>
</tbody>
 
Upvote 0
Re: Help With Arranging data in a spreadsheet using VBA

I get subscript out of range Error 9 on the below code would you know why?

Sub MG02Nov58()
Dim Ray As Variant, n As Long, c As Long, Ac As Long
Ray = Cells(1).CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * Int(UBound(Ray, 2) / 14), 1 To 17)
nray(1, 1) = "Date": nray(1, 2) = "Report Type": nray(1, 3) = "Applicant ID": nray(1, 4) = "Applicant Name"
nray(1, 5) = "Package Name": nray(1, 6) = "Reference": nray(1, 7) = "Billing Code": nray(1, 8) = "Location": nray(1, 9) = "Run By": nray(1, 10) = "Base": nray(1, 11) = "Fees"
nray(1, 12) = "Total": nray(1, 13) = "Description": nray(1, 14) = "Base": nray(1, 15) = "Fees": nray(1, 16) = "Total"
c = 1
For n = 2 To UBound(Ray, 1)
For Ac = 4 To UBound(Ray, 2) Step 4
If Ray(n, Ac) <> "" Then
c = c + 1
nray(c, 1) = Ray(n, 1)
nray(c, 2) = Ray(n, 2)
nray(c, 3) = Ray(n, 3)
nray(c, 4) = Ray(n, 4)
nray(c, 5) = Ray(n, 5)
nray(c, 6) = Ray(n, 6)
nray(c, 7) = Ray(n, 7)
nray(c, 8) = Ray(n, 8)
nray(c, 9) = Ray(n, 9)
nray(c, 10) = Ray(n, 10)
nray(c, 11) = Ray(n, 11)
nray(c, 12) = Ray(n, 12)
nray(c, 13) = Ray(n, Ac)
nray(c, 14) = Ray(n, Ac + 1)
nray(c, 15) = Ray(n, Ac + 2)
nray(c, 16) = Ray(n, Ac + 3)
End If
Next Ac
Next n
With Sheets("Sheet2").Range("A1").Resize(c, 16)
.Value = nray
.Borders.Weight = 2
.Columns.AutoFit
End With
End Sub
 
Upvote 0
Re: Help With Arranging data in a spreadsheet using VBA

Try this for results on sheet2.
The results list now has 16 columns, that's 12 basic columns then 4 extra columns for each set of 4 (Component, Base, Fee, Total) columns.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG03Nov32
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Cells(1).CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * Int(UBound(Ray, 2) / 4), 1 To 16)
nray(1, 13) = "Component": nray(1, 14) = "Base": nray(1, 15) = "Fees": nray(1, 16) = "Total"
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 13 To UBound(Ray, 2) [COLOR="Navy"]Step[/COLOR] 4
      [COLOR="Navy"]If[/COLOR] Ray(n, Ac) <> "" [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            [COLOR="Navy"]For[/COLOR] nn = 1 To 12
                nray(1, nn) = Ray(1, nn)
                nray(c, nn) = Ray(n, nn)
            [COLOR="Navy"]Next[/COLOR] nn
            
            nray(c, 13) = Ray(n, Ac)
            nray(c, 14) = Ray(n, Ac + 1)
            nray(c, 15) = Ray(n, Ac + 2)
            nray(c, 16) = Ray(n, Ac + 3)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 16)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Re: Help With Arranging data in a spreadsheet using VBA

Thanks a Tonn!!

Mick you saved me a tonn of Man hours
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Help with FilterXML formula
Replies
0
Views
1K
montex01
M
S
  • Question
Macro to extract Columns based on multiple criteria
Replies
6
Views
3K
Trebor76
T
D
  • Question
How to output a dynamic range where the height of the range varies
Replies
0
Views
974
dagda13
D
C
  • Question
Sum
Replies
3
Views
1K
pbornemeier
pbornemeier
JTL9161
  • Question
Sorting Rank Results
Replies
4
Views
952
JTL9161
JTL9161

Forum statistics

Threads
1,214,940
Messages
6,122,361
Members
449,080
Latest member
Armadillos

Share this page

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