How to put many columns into one single colulm sorted by the first to last coloum

mickeb

New Member
Joined
Jan 15, 2011
Messages
26
Hello im new here and new into VB coding!


here is a picture what i want to do
output.jpg



Basiclly im looking for a for a fuction that selects the left side (raw data all cells and columns) and order them into a single column. I got a function like this but this is not perfect...
=INDEX($A$2:$B$11;MOD(ROWS(D$1:D1)-1;ROWS($A$2:$B$11))+1;INT((ROWS(D$1:D1)-1)/ROWS($A$2:$B$11))+1)

The ranged selection need to be picked automaticly after N counted firms (ex. based on a other cell colums which state how many companies exists using "countA" or similar instead of a static: $A$2:$B$11 more like something like $A$2:[$endColumn$endRow) for the colums it could count amount of YEARS. The second is if its a blank observation it needs to return a blank not a zero as its now.

To make example the above code would be wrong since looking at the picture the firm 12 is at row 13 so the range would be $A2:$B13 instead of $B$11. More on, $B would be the letter which is in year 2020 (the ending year)

If i could just get a custom function where i could specify n firms and n years eg. function ColumnsToSingleColumn(FIRMS#;YEAR#) would be great.


I hope u understand the question. if not let me know so i can be more clear.
best regards
Mike
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
mickeb,

Welcome to the MrExcel forum.


You are posting a picture. This means that if this was a problem where one needed to use your data, anyone trying to help you would have to enter the data manually. That makes no sense and I doubt that you would get any answer.

Please attach screenshots of your workbook or a sample workbook that accurately portrays your current workbook on one sheet, and what it should look like 'After' on another sheet. This makes it much easier to see exactly what you want to do, as well as shows us whether there is a consistent number of rows between tables and such.

Here are three possible ways to post small (copyable) screen shots directly in your post:

Please post a screenshot of your sheet(s), what you have and what you expect to achieve, with Excel Jeanie HTML 4 (contains graphic instructions).
http://www.excel-jeanie-html.de/html/hlp_schnell_en.php

or
RichardSchollar’s beta HTML Maker -...his signature block at the bottom of his post

or
Borders-Copy-Paste


Or, you can upload your workbook to www.box.net and provide us with a link to your workbook.
 
Upvote 0
Try this:-
Results start on sheet (2). "A1"
NB:- The Code assumes that cell "A1 of your data is the cell with Header "Company/Year" in it
Code:
[COLOR=navy]Sub[/COLOR] MG15Jan27
[COLOR=navy]Dim[/COLOR] ColRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] ac [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Col [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] nRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] rw [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Hds [COLOR=navy]As[/COLOR] Variant
n = 1
Hds = Array("Obs", "Comp", "Year", "Item X")
[COLOR=navy]Set[/COLOR] ColRng = Range(Range("A1"), Cells(1, Columns.Count).End(xlToLeft))
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count * ColRng.Count, 1 To 4)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Col [COLOR=navy]In[/COLOR] ColRng
    [COLOR=navy]If[/COLOR] Col.Column < 5 [COLOR=navy]Then[/COLOR]
        ray(1, Col.Column) = Hds(Col.Column - 1)
    [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Set[/COLOR] nRng = Rng.Offset(1, Col.Column).Resize(Rng.Count - 1)
    rw = 0
[COLOR=navy]If[/COLOR] Col.Column < 6 [COLOR=navy]Then[/COLOR]
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] nRng
        n = n + 1
        rw = rw + 1
        ray(n, 1) = n - 1: ray(n, 2) = Rng(rw + 1)
        ray(n, 3) = ColRng(1, Col.Column + 1): ray(n, 4) = Dn
    [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Col
Sheets("Sheet2").Range("A1").Resize(n + 1, 4) = ray
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
mickeb,


Sample data before the macro:


Excel Workbook
ABCDEFG
1ITEM X
2COMPANY / YEAR20012002
3Firm 1100200
4Firm 2300300
5Firm 3300300
6Firm 4200600
7Firm 5500
8Firm 6100200
9Firm 7200300
10Firm 850018
11Firm 9500
12Firm 10300500
13
14
15
16
17
18
19
20
21
22
23
Sheet1





After the macro:


Excel Workbook
ABCDEFG
1ITEM X
2COMPANY / YEAR20012002ObsYEARITEM X
3Firm 110020012002200
4Firm 230030022002300
5Firm 330030032002300
6Firm 420060042002600
7Firm 550052002500
8Firm 610020062002200
9Firm 720030072002300
10Firm 8500188200218
11Firm 950092002
12Firm 10300500102002500
13112001100
14122001300
15132001300
16142001200
17152001
18162001100
19172001200
20182001500
21192001500
22202001300
23
Sheet1





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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code:
Option Explicit
Sub ReorgData()
' hiker95, 01/15/2011
' http://www.mrexcel.com/forum/showthread.php?t=521539
Dim LR As Long, LC As Long, NR As Long, n As Long, a As Long
Application.ScreenUpdating = False
Worksheets("Sheet1").Activate
LC = Cells(2, Columns.Count).End(xlToLeft).Column
If LC > 3 Then
  LR = Cells(Rows.Count, 5).End(xlUp).Row
  Range(Cells(1, 4), Cells(LR, LC)).Clear
End If
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(2, Columns.Count).End(xlToLeft).Column
Range(Cells(2, LC + 2), Cells(2, LC + 3)) = [{"Obs","YEAR"}]
Cells(2, LC + 4) = Range("A1").Value
n = LR - 2
NR = 3
For a = LC To 2 Step -1
  Cells(NR, LC + 3).Resize(n).Value = Cells(2, a).Value
  Cells(NR, LC + 4).Resize(n).Value = Cells(3, a).Resize(n).Value
  NR = NR + n
Next a
n = (LR - 2) * (LC - 1)
Cells(3, LC + 2) = 1
Cells(4, LC + 2).Formula = "=E3+1"
Cells(4, LC + 2).AutoFill Destination:=Range(Cells(4, LC + 2), Cells(4 + n - 2, LC + 2))
With Range(Cells(4, LC + 2), Cells(4 + n - 2, LC + 2))
  .Value = .Value
End With
Application.ScreenUpdating = True
End Sub


Then run the ReorgData macro.
 
Upvote 0
Thanks Hiker95 and MickG works nice for now, wonder if its hard to separte the subrutine into 3 categories?

one order observations 1 to counted rows in sample

second subrutine order year and companies, in other words, single row into repeated single row (repeat the year or sample of firms until it reaches total observations.

Third, select the array of items and paste them from diffrent colulms into one column


Why 3 subrutines u ask? because then i can have more like a generic method to sort any kind of data fast.

If u can do, all this subrutines can report into sheet2 and each subrutine need to paste after the next available free column.

so for example if i already used subrutine 1 (total observation ordering), it adds to sheet2 and column A,

Then next used subrutine should paste to A if its empty else to B and so on, check for the last unavaible colulmn and put it after that

hope its not much to ask. Im really enyoning learning vba
 
Upvote 0
mickeb,

I re-wrote my macro so that the results would be in a new worksheet Results.


Can you post another workbook:

1. with Sheet1 containing just your raw data (without any additional rows or instructions).

2. with Sheet2 or Results with what the raw data should look like after your latest request.
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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