Rearranging large amounts of data

Originally Posted by cjo

First, though, what I meant by "Nice Rectangle" is each company has the same number of rows. That is fairly simple thing to do with formulas. If each company has a different number of rows underneath them, then I can't think of a formula off hand that wouldn't require a clean up using an autofilter.

Sorry I should have been clearer. They have different numbers of rows.

As to the assumptions, I think we've got some tenses confused. In your current sheet, can the company names can be seen in cells A1, M1, Y1, etc?
Also, I'm just leaving the top row blank for the headers. So long as your headers h1, h2, etc don't change value, you should only have to copy/paste it over once.

Close they are currently in B1, O1, AB1 etc. - but they are also in the first column of each table(A3-,N3-, ec.) so perhaps for ease I should remove this first row?

As to some new information you just provided, is your data is currently spread across multiple worksheets? If so, it could be possible to save you some effort. Do the worksheets have some sort of similarity in the names, or some other way to give a good positive identification that they should be included in this cleanup/merge?

They are named the same except numbered 1-14 at the end of the filename, but as I mentioned this is a small number so I don't mind doing them singly.


Tested the macro and it seems very close to doing what I want, although there seems to be an error. Company A's data looks perfect, but for B's the data all shifts one square to the right (and column M goes to column B). After this company there is a string of numbers in the B column, before the next company which is further right-shifted, then string in B & C, then next company further right-shifted etc.
Wish I could troubleshoot this myself but the code looks completely alien to me. Any ideas?


Again massive thanks for the help so far!

Ok,now that one piece of confusion is cleared up (where the company names are held), and I think I've got one other piece of confusion cleared up (the number of columns per item in the original dataset is 13, not 12 as I had on the last revision), we can now get down to business.

I'm going to ask you to change something in the following code. You said that all the sheetnames are the same, except that they are followed by 1, 2, ... ,14. There's a line

If wsInput.Name Like "TheCommonName*" Then

where you should replace the "TheCommonName*" with "Data*" or "Companies*" (notice the star) with whatever is your naming convention -- provided that all worksheets are in the same workbook. If they aren't, you'll need to remove that line, this line

For Each wsInput In ActiveWorkbook.Worksheets

and these two lines at the end.

        End If
    Next wsInput

(make sure that the 'end if' directly above the Next wsInput is removed.
and then, right above

Set wsOutput = Worksheets.Add

put back in

Set wsInput = ActiveSheet

any way, hopefully this won't be a problem, so try this:

Sub FixFourColumnData()
    Dim lCtrIn           As Long
    Dim lCtrOut          As Long
    Dim lColNbr          As Long

    Dim wsInput          As Worksheet
    Dim wsOutput         As Worksheet


    Set wsOutput = Worksheets.Add


    lCtrOut = 2


    For Each wsInput In ActiveWorkbook.Worksheets
        'the next line is where you should put in the text common
        'to all the worksheets you're interested in.  Be sure to
        'use a * for a wildcard where the number would appear.
        If wsInput.Name Like "TheCommonName*" Then
            lColNbr = 1
            lCtrIn = 3
            Do
                'check to see if we're at the end of a col.
                'if so, move over to next group of 13, and reset
                'to the first row of data
                If wsInput.Cells(lCtrIn, lColNbr) = "" Then
                    lColNbr = lColNbr + 13
                    lCtrIn = 3
                    If wsInput.Cells(lCtrIn, lColNbr) = "" Then Exit Do
                    'check to see if the first item in the 13 column group
                    'is blank.  if it's blank, we've ran through the
                    'whole data set for the given company.
                End If

                'copy the info to the output sheet
                wsOutput.Cells(lCtrOut, 1) = wsInput.Cells(1, lColNbr + 1)
                wsOutput.Range(wsOutput.Cells(lCtrOut, 2), wsOutput.Cells(lCtrOut, 14)).Value _
                        = wsInput.Range(wsInput.Cells(lCtrIn, lColNbr), wsInput.Cells(lCtrIn, lColNbr + 12)).Value
                'set the counter to look at the next row on the input sheet.
                lCtrIn = lCtrIn + 1
                'set the counter to output to the next row on the output sheet
                lCtrOut = lCtrOut + 1
            Loop
        End If
    Next wsInput
End Sub

cjo,

You're an absolute lifesaver thank you so much. Works perfectly!

I'm so happy about this- thanks again you've made my day!