Take Multiple Instances from a Row and Move to a Column

Hi HangMan,

Forgive me, but it may be worth you pointing out to readers of this post in what way it differs from this previous post of yours, and perhaps also the reasons it can't be continued therein:

http://www.excelforum.com/excel-prog...readsheet.html

Regards

Hi XOR LX,

I did ask the question as to whether I should continue this in the previous post, (see post 30 in the thread). Jaslake (post 31) suggested making a new post, hence the reason for this post.

Basically the difference here is that I need to be able to do the whole process in reverse, the original post was taking multiple instances from 4 columns and putting them into rows, now I need to be able to take multiple instances from single rows and put them back into columns. Hopefully the 'Source' and 'Outcome' tabs on the attchment will show what I am trying to achieve.

Many thanks

Ok, understood. Thanks for the clarification and I trust that someones with expertise in VBA will answer your request shortly.

Regards

Hi HangMan

Try this

Option Explicit

Sub Reverse_Engineer()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim rng As Range, szCell As Range
    Dim i As Long, j As Long, LR As Long, LC As Long, LC1 As Long, cnt As Long
    Dim szLastValue As String

    Set ws = Sheets("Source Data")
    Set ws1 = Sheets("Outcome")
    
    Application.ScreenUpdating = False
    With ws1
        .Cells.Clear
        ws.Cells.Copy Destination:=.Range("A1")
        .Activate
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column

        Set rng = .Range("A2:A" & LR)
        
        For i = LR To 2 Step -1
            LC1 = .Range(.Cells(i, 1), (.Cells(i, LC))).Find(What:="*", LookIn:=xlValues, _
                    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            If LC1 > 4 Then
                cnt = 1
                .Cells(i, 1).Offset(1, 0).Resize((((LC1 - 1) / 3) - 1), 1).EntireRow.Insert
                For j = 5 To LC1 Step 3
                    .Cells(i, j).Resize(1, 3).Copy
                    .Range(.Cells(i + cnt, "B"), (.Cells(i + cnt, "B"))).PasteSpecial
                    cnt = cnt + 1
                Next j
            End If
        Next i

        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        .Range("A2:A" & LR).Select

        szLastValue = ""
        For Each szCell In Selection.Cells
            If Trim(szCell.Value) <> "" Then
                szLastValue = szCell.Value
            Else
                If szLastValue <> "" Then szCell.Value = szLastValue
            End If
        Next szCell
        .Range(.Cells(1, 5), .Cells(1, LC)).EntireColumn.Delete
        .Range("B1").Value = "Country"
        .Range("C1").Value = "Animal"
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Hi HangMan

No clue what's going on. The Code finds the last Column...whether that's 1 entry or 100 entries. I'd need to see the File. Either the Code is broke or the File is different. Attach the offending File and I'll look at it.

Hi HangMan

So your File Structure is different. You SIMPLY can't do this

I simply added one extra column per 'set', colour, so there are effectively now 4 entries per set

Code is written to deal with your File Structure.

When you've developed your Final File Structure let us know...perhaps one of us can help.

Please attach a sample file that represents what you have. The structure of your attachment should be the same structure as your actual data. Any proprietary information should be changed.

Include in the attachment any code you're currently using (whether it works or not) and an "After" worksheet that demonstrates what you wish the output to be.

To Attach a File:

1. Click on Go Advanced
2. In the frame Attach Files you will see the button Manage Attachments
3. Click the button.
4. A new window will open titled Manage Attachments - Excel Forum.
5. Click the "Add Files"... button to locate your file for uploading.
6. This will open a new window File Upload...Click "Select Files"
7. Once you have located the file to upload click the Open button. This window will close.
8. You are now back in the Manage Attachments - Excel Forum window.
9. Click the "Upload Files" button and wait until the file has uploaded.
10. Click the "Done" Button.

Hi HangMan

I think you've explained it to yourself...

The only thing I changed was to have four columns of data rather than three

Four columns of data rather than three is a change in the File Structure. The Code is looking for three columns of data...not four.

Hi HangMan

The Code adapts itself to as many Columns you wish to throw at it. It does not adapt to the number of Columns in a Data Set. The Code is set for 3.

If you have different Files with different Data Sets this may be able to be accommodated.

You're welcome...glad I could help. Thanks for the Rep.