Covert cells with multiple data to rows

maxnimrod · Aug 16, 2017

We use a SharePoint library for end users to submit requests for changes. Because they can submit multiple lines of changes, this produces an output file like the one below.

I don't mind copying the data and pasting it to another sheet. However that can be quite time consuming when there are dozens of requests. Plus, other people may process these so I need an easier solution.

[TABLE="width: 673"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[/TR]
[TR]
[TD]Row1[/TD]
[TD]Record #[/TD]
[TD]Date[/TD]
[TD]Requestor[/TD]
[TD]R#[/TD]
[TD]U#[/TD]
[TD]Data1[/TD]
[TD]Data2[/TD]
[TD]Data3[/TD]
[TD]# of Requests[/TD]
[/TR]
[TR]
[TD]Row2[/TD]
[TD]101[/TD]
[TD]4-Jul[/TD]
[TD]John[/TD]
[TD]2001[/TD]
[TD]ABC[/TD]
[TD]Red[/TD]
[TD]Green[/TD]
[TD]Yes[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD]2002[/TD]
[TD]DEF[/TD]
[TD]Brown[/TD]
[TD]Orange[/TD]
[TD]No[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD]2003[/TD]
[TD]GHI[/TD]
[TD]Purple[/TD]
[TD]Blue[/TD]
[TD]No[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD]2004[/TD]
[TD]JKL[/TD]
[TD]Yellow[/TD]
[TD]Pink[/TD]
[TD]Yes[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]2005[/TD]
[TD]MNO[/TD]
[TD]Black[/TD]
[TD]White[/TD]
[TD]No[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Row3[/TD]
[TD]104[/TD]
[TD]7-Jul[/TD]
[TD]Mike[/TD]
[TD]3011[/TD]
[TD]PFY[/TD]
[TD]Red[/TD]
[TD]Green[/TD]
[TD]Yes[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD]3012[/TD]
[TD]GHK[/TD]
[TD]Brown[/TD]
[TD]Orange[/TD]
[TD]No[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD]3013[/TD]
[TD]DCC[/TD]
[TD]Purple[/TD]
[TD]Blue[/TD]
[TD]No[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD]3014[/TD]
[TD]MMZ[/TD]
[TD]Yellow[/TD]
[TD]Pink[/TD]
[TD]Yes[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]3015[/TD]
[TD]XGF[/TD]
[TD]Black[/TD]
[TD]White[/TD]
[TD]No[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Row 4[/TD]
[TD]105[/TD]
[TD]9-Jul[/TD]
[TD]Jack[/TD]
[TD]2009[/TD]
[TD]DCF[/TD]
[TD]Green[/TD]
[TD]Black[/TD]
[TD]No[/TD]
[TD]1[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col span="5"><col></colgroup>[/TABLE]

For example, On July 4th, John submitted a request that contained 5 changes. His request first request # is 2001 and he needs artifact ABC changed from Red to Green. And yes or no for manager approval.
Column I contains the number of requests Each user submitted, so that may be helpful. You will notice that the request in row 4 only contained 1 request. So those would be ok as they are.

I need an easy way to put each row of data that a user submits into it's own row. I don't care so much if columns A, B and C don't get copied down. It is easy enough to drag them after the fact.

Any advice would be greatly appreciated.
Thank

frank_AL · Aug 16, 2017

maxnimrod,

This code copies the data from Sheet1 to Sheet2. For now, this does not copy the data to something like a master Workbook but that would be easy enough to add if needed.
If this isn't exactly what you need provide details of what needs changing and I will work to incorporate that into an updated code module.

Code:

Option Explicit
Sub CopyData()
Dim i As Long
Dim x As Long
Dim cflr As Long
Dim ctlr As Long
Dim lastrec As Long
Dim CFws As Worksheet
Dim CTws As Worksheet


Set CFws = Sheets("Sheet1")  '  Copy From Worksheet
Set CTws = Sheets("Sheet2")  '  Copy To Worksheet


cflr = CFws.Cells(Rows.Count, "A").End(xlUp).Row  '  Copy From WorkSheet Last Row


For i = 2 To cflr
ctlr = CTws.Cells(Rows.Count, "A").End(xlUp).Row + 1  '  Copy To WorkSheet Last Row
lastrec = CFws.Cells(i, 9).Value
    
    For x = i To (i + lastrec - 1)
        CFws.Cells(i, 1).Copy Destination:=CTws.Cells(ctlr, 1)
        CFws.Cells(i, 2).Copy Destination:=CTws.Cells(ctlr, 2)
        CFws.Cells(i, 3).Copy Destination:=CTws.Cells(ctlr, 3)
        CFws.Cells(x, 4).Copy Destination:=CTws.Cells(ctlr, 4)
        CFws.Cells(x, 5).Copy Destination:=CTws.Cells(ctlr, 5)
        CFws.Cells(x, 6).Copy Destination:=CTws.Cells(ctlr, 6)
        CFws.Cells(x, 7).Copy Destination:=CTws.Cells(ctlr, 7)
        CFws.Cells(x, 8).Copy Destination:=CTws.Cells(ctlr, 8)
        ctlr = ctlr + 1
    Next x
Next i


End Sub

maxnimrod · Aug 16, 2017

Hi,

Thank you for your reply. I can see this working, however, the results are mostly the same as Sheet1. When it does create a new row, it doesn't fill in anything after column C. I think your idea Is spot on, but I think the issue is the data itself. For columns D-H. If I copy one row of my data to a plain text editor this is what I see. Column A, B and C are clean. Only the data we see. However, starting with column D, each group of data begins and end with a quote " there is nothing between each value. I don't know if that fact is helpful or detrimental.

Thank you again for your help))

frank_AL · Aug 16, 2017

That's helpful information but can you post a screenshot of a set of rows for an individual person? Follow the Forum Use Guidelines for instructions on how to do this.
Feel free to edit any personally identifiable data, I just need to know the actual structure of the data.

I'm hoping the data is in specific text positions so that it will be easy to parse.

maxnimrod · Aug 17, 2017

Thank you again for your reply. I can't use the add ins at work. I will try and get this sheet home and try that tonight.

In the meantime, I can tell you that all the data is stacked in the cells and it is aligned to the bottom of the cells. Not sure if that is helpful or not. I will get you the screenshot as soon as I can.

Thank you!!

maxnimrod · Aug 19, 2017

Here we go)) There are 4 rows of data. Let me know if there is anything else you want to see. The data is actually requests for UNC path changes. I scrubbed the ID's and paths. Thank you ))

Book1

A

B

C

D

E

F

G

H

I

1

ID

Processing Date

Submitted By

Request Number

ID

NEW Path

OLD Path

Group

Count

2

1166

8/16/2017

John

3982305 3990521 3990601 3990605 3990607 3990608 3992829 3992835 3992850 3992874 3992878

ID001 ID002 ID003 ID004 ID005 ID006 ID007 ID008 ID009 ID010 ID011

\\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user

true true true true true true true true true true true

11

3

1167

8/16/2017

Mike

3942554

ID106

\\server\path\user

true

1

4

1168

8/16/2017

Jack

4002114 4002113 4002062 4002053 4002051 4000028 3999940

ID11001 ID11002 ID11003 ID11004 ID11005 ID11006 ID11007

\\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user

true true true true true true true

7

5

1169

8/16/2017

Cindy

3982425 3989379 3989984 3992887 3992893 3995697 3995786 3999639

ID110013 ID110023 ID110033 ID110043 ID110053 ID110063 ID110073 ID110098

\\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user \\server\path\user

true true true true true true true true

8

Sheet1

frank_AL · Aug 30, 2017

Okay, sorry to be so long getting back to you. Been dealing with personal issues on my end!

Give this code a try. The assumption here is that the data in Columns D-H is separated with a space " ". It is possible it might be separate with a line feed and if so it will take a minor modification the lines of code that Split the data into the arrays so let me know if this fails on your actual data.

Code:

Option Explicit
Sub CopyData()
Dim i As Long
Dim x As Long
Dim cflr As Long
Dim ctlr As Long
Dim cnt As Long
Dim CFws As Worksheet
Dim CTws As Worksheet
Dim Req As String
Dim ID As String
Dim NP As String
Dim OP As String
Dim Grp As String




Set CFws = Sheets("Sheet4")  '  Copy From Worksheet
Set CTws = Sheets("Sheet5")  '  Copy To Worksheet


cflr = CFws.Cells(Rows.Count, "A").End(xlUp).Row  '  Copy From WorkSheet Last Row


For i = 2 To cflr
    ctlr = CTws.Cells(Rows.Count, "A").End(xlUp).Row + 1  '  Copy To WorkSheet Last Row
    cnt = CFws.Cells(i, 9).Value
    ReDim ReqArray(1 To cnt) As String
    ReDim IDArray(1 To cnt) As String
    ReDim NPArray(1 To cnt) As String
    ReDim OPArray(1 To cnt) As String
    ReDim GrpArray(1 To cnt) As String
    Req = CFws.Cells(i, 4)
    ID = CFws.Cells(i, 5)
    NP = CFws.Cells(i, 6)
    OP = CFws.Cells(i, 7)
    Grp = CFws.Cells(i, 8)
    ReqArray = Split(Req)
    IDArray = Split(ID)
    NPArray = Split(NP)
    OPArray = Split(OP)
    GrpArray = Split(Grp)
    
    For x = 1 To (cnt)
        CFws.Cells(i, 1).Copy Destination:=CTws.Cells(ctlr, 1)
        CFws.Cells(i, 2).Copy Destination:=CTws.Cells(ctlr, 2)
        CFws.Cells(i, 3).Copy Destination:=CTws.Cells(ctlr, 3)
        CTws.Cells(ctlr, 4) = ReqArray(x - 1)
        CTws.Cells(ctlr, 5) = IDArray(x - 1)
        CTws.Cells(ctlr, 6) = NPArray(x - 1)
        CTws.Cells(ctlr, 7) = OPArray(x - 1)
        CTws.Cells(ctlr, 8) = GrpArray(x - 1)
        ctlr = ctlr + 1
    Next x
Next i


End Sub

Fluff · Aug 30, 2017

Hia
Here's another option for you.
This converts the data on the same sheet, rather than copying to a new sheet.
Like frank_AL' code this assumes that the data in cols D to G is split on a space, but can be changed

Code:

Sub SplitRws()
' maxnimrod (zz2)

    Dim UsdRws As Long
    Dim Rws As Long
    Dim Cnt As Long
    Dim Cols As Long

Application.ScreenUpdating = False

    UsdRws = Range("A" & Rows.Count).End(xlUp).Row
    
    For Rws = UsdRws To 2 Step -1
        Cnt = Range("I" & Rws).Value
        If Cnt > 1 Then
            Rows(Rws + 1).Resize(Cnt - 1).Insert
            Range("A" & Rws & ":C" & Rws).Resize(Cnt).FillDown
            For Cols = 4 To 8
                Cells(Rws, Cols).Resize(Cnt).Value = Application.Transpose(Split(Cells(Rws, Cols).Value))
            Next Cols
        End If
    Next Rws

End Sub

frank_AL · Aug 30, 2017

Fluff said:

Hia
Here's another option for you.
This converts the data on the same sheet, rather than copying to a new sheet.
Like frank_AL' code this assumes that the data in cols D to G is split on a space, but can be changed

Code:

Sub SplitRws()
' maxnimrod (zz2)

    Dim UsdRws As Long
    Dim Rws As Long
    Dim Cnt As Long
    Dim Cols As Long

Application.ScreenUpdating = False

    UsdRws = Range("A" & Rows.Count).End(xlUp).Row
    
    For Rws = UsdRws To 2 Step -1
        Cnt = Range("I" & Rws).Value
        If Cnt > 1 Then
            Rows(Rws + 1).Resize(Cnt - 1).Insert
            Range("A" & Rws & ":C" & Rws).Resize(Cnt).FillDown
            For Cols = 4 To 8
                Cells(Rws, Cols).Resize(Cnt).Value = Application.Transpose(Split(Cells(Rws, Cols).Value))
            Next Cols
        End If
    Next Rws

End Sub

Fluff, your code is the very reason I participate on this Forum. Your code is certainly more efficient and gets the job done!

Frank_al

Fluff · Aug 30, 2017

Thanks for that Frank_al
I'm here for the same reasons, a few months a probably couldn't have done this.

Covert cells with multiple data to rows

maxnimrod

New Member

Excel Facts

frank_AL

Active Member

maxnimrod

New Member

frank_AL

Active Member

maxnimrod

New Member

maxnimrod

New Member

frank_AL

Active Member

Fluff

MrExcel MVP, Moderator

frank_AL

Active Member

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Covert cells with multiple data to rows

New Member

Excel Facts

Active Member

New Member

Active Member

New Member

New Member

Active Member

MrExcel MVP, Moderator

Active Member

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock