Text To Row In A Dynamic Excel Spreadsheet

[mellis]

Hi All,

I am working on a dynamic spreadsheet sucking information from our company CRM platform (Microsoft Dynamics).

Column B details facility number, which ranges between 2 - 4 numbers, however there may be 2 facilities to the same client (and row) as illustrated below:

10/09/2008	52	ABC Ltd	Mike Ellis	750,000	100
11/09/2008	1052 1053 1054	BCD Ltd	Andrew Briggs	500,000	500
11/09/2008	2015 2017	CDE Ltd	Kiera Fryar	1,500,000	500
12/09/2008	2016	DEF Ltd	Sally Taylor	10,000,000	2,500
12/09/2008	1569	EFG Ltd	Bruce Hort	750,000	250
14/09/2008	1571	FGH Ltd	Paul Rossiter	150,000	150

<tbody>
</tbody>

I need the table to look as follows:

10/09/2008	52	ABC Ltd	Mike Ellis	750,000	100
11/09/2008	1052	BCD Ltd	Andrew Briggs	500,000	500
11/09/2008	1053	BCD Ltd	Andrew Briggs
11/09/2008	1054	BCD Ltd	Andrew Briggs
11/09/2008	2015	CDE Ltd	Kiera Fryar	1,500,000	500
11/09/2008	2017	CDE Ltd	Kiera Fryar
12/09/2008	2010	DEF Ltd	Sally Taylor	10,000,000	2,500
12/09/2008	1569	EFG Ltd	Bruce Hort	750,000	250
14/09/2008	1571	FGH Ltd	Paul Rossiter	150,000	150

<tbody>
</tbody>

Given that this is a dynamic table with information refreshing each time we open the spreadsheet your help would be appreciated in the automated steps either in basic VBA (very small amount of experience building macros) or in formulas.

For info , there is a very large amount of data in the real spreadsheet so automation really is the key here.

I have considered work arounds with new tabs and copied data and this would be fine providing it gave me the solution required.

Many Thanks!

 

[WarPigl3t]

Sub myMacro()
    i = 1 [COLOR=#008000]'If you have headers i = 2[/COLOR]
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Do Until i > lastRow
        mySplit = Split(Trim(Range("B" & i).Value), " ")
        If UBound(mySplit) > 0 Then
            Range("B" & i).Value = mySplit(0)
            bool = True
            x = i
            For Each Item In mySplit
                If bool = False Then
                    Rows(i + 1).Insert
                    Range("B" & i + 1).Value = Item
                    Range("A" & i + 1).Value = Range("A" & x).Value
                    Range("C" & i + 1).Value = Range("C" & x).Value
                    Range("D" & i + 1).Value = Range("D" & x).Value
                    i = i + 1
                End If
                bool = False
            Next Item
            i = i - 1
        End If
        i = i + 1
    Loop
End Sub

 

[mellis]

Thanks Warpig, this solution works perfectly!

You have saved our bacon *bad joke, but couldnt resist*

 

[mellis]

So I have got further down the line and sadly the order of execution is causing problems.

The formula works, but is running on start up...then my dynamic table is refreshing over-riding the good work that has been executed.

Is there a way to run the code after the dynamic table refresh?

Thanks

 

[WarPigl3t]

Private Worksheet_Change()
    call myMacro()
End Sub

Note: The line of code starting with Private may not be correct. Here's how to get the right one. Right click the worksheet tab name you are talking about. Select "View Code" from the menu. A VBA module appears. From the left drop down list, select "Worksheet". From the right drop down list select "Change". Then the Private handler appears. Insert Call myMacro() into the code.

 

[mellis]

Thats great thank you.

The final missing peice now is that I have extended the number of collums being copied down. The issue being that I would like collumn "O" to copy the formula from the cell above +1 ( =B10*Y10 instead of =B10*X11 or even =B11*Y11 would work)


i = 2 'If you have headers i = 2
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Do Until i > lastRow
mySplit = Split(Trim(Range("B" & i).Value), " ")
If UBound(mySplit) > 0 Then
Range("B" & i).Value = mySplit(0)
bool = True
x = i
For Each Item In mySplit
If bool = False Then
Rows(i + 1).Insert
Range("B" & i + 1).Value = Item
Range("A" & i + 1).Value = Range("A" & x).Value
Range("C" & i + 1).Value = Range("C" & x).Value
Range("D" & i + 1).Value = Range("D" & x).Value
Range("E" & i + 1).Value = Range("E" & x).Value
Range("O" & i + 1).Value = Range("O" & x).Value

 

[WarPigl3t]

accordig to the code, column O is nothing more than a value; The final value of what was split in the B column. So there is no formula there.

 

[Peter_SSs]

For info , there is a very large amount of data in the real spreadsheet ...

1. Could you give us an idea of what "a very large amount of data" means in relation to your worksheet?

2. Related to the above, does WarPiglet's code, when run on your "very large data", appear to produce the results ..
a) Instantaneously,
b) Within a couple of seconds,
c) More than 10 seconds,
d) A very long time

The issue being that I would like collumn "O" to copy the formula from the cell above +1 ( =B10*Y10 instead of =B10*X11 or even =B11*Y11 would work)

I think I'm like WarPiglet on this - unsure what you really mean/want. Can you spell it out in more detail and perhaps give a few actual examples to demonstrate?

 

[apo]

Give this a try..

I tested it on 50 000 rows (repetitious data using your posted values).. it did it in less than 2 seconds.. but..

When i tested it on 100 000 rows.. it errored.. I am pretty sure it is due to the way I am Redimming the Y array (Transpose has probably met its limit here)..

@ Peter.. any advice on how I can Redim that Y array without running into this issue?

Private Sub CommandButton1_Click()
 Dim x, y, cnt As Long, k As Long, s As Long, j As Long, i As Long, ii As Long
    With Range("A1").CurrentRegion
        x = .Offset(1).Resize(.Rows.Count - 1).Value
        cnt = 1: k = 1: s = 1
        ReDim y(1 To UBound(Split(Replace(Join(Application.Transpose(.Columns(2).Offset(1).Resize(.Rows.Count - 1).Value), vbLf), vbLf, Chr(32)), Chr(32))) + 1, 1 To 6)
        For i = 1 To UBound(y)
            For j = 0 To UBound(Split(x(cnt, 2), Chr(32)))
                For ii = 1 To UBound(x, 2)
                    If ii = 2 Then
                        y(k, ii) = Trim(Split(x(cnt, 2), Chr(32))(j))
                    Else
                        y(k, ii) = Trim(x(cnt, ii))
                    End If
                Next ii
                If s = UBound(Split(x(cnt, 2), Chr(32))) + 1 Then
                    k = k + 1: cnt = cnt + 1: Exit For
                Else
                    k = k + 1: s = s + 1
                End If
            Next j
            s = 1
            If k > UBound(y) Then
                With Sheets("Sheet2")
                    .Range("A2").Resize(UBound(y), 6).Value = y
                    .Columns(1).NumberFormat = "mm/dd/yyyy"
                    .Columns.AutoFit
                    .Select
                End With
                Exit Sub
            End If
        Next i
    End With
End Sub

<b>Sheet1</b><br /><br /><table border="1" cellspacing="0" cellpadding="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:75px;" /><col style="width:98px;" /><col style="width:54px;" /><col style="width:97px;" /><col style="width:71px;" /><col style="width:39px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >Date</td><td >Facility</td><td >Company</td><td >Contact</td><td >Val1</td><td >Val2</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="text-align:right; ">10/09/2008</td><td style="text-align:right; ">52</td><td >ABC Ltd</td><td >Mike Ellis</td><td style="text-align:right; ">750,000</td><td style="text-align:right; ">100</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="text-align:right; ">11/09/2008</td><td >1052 1053 1054</td><td >BCD Ltd</td><td >Andrew Briggs</td><td style="text-align:right; ">500,000</td><td style="text-align:right; ">500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="text-align:right; ">11/09/2008</td><td >2015 2017</td><td >CDE Ltd</td><td >Kiera Fryar</td><td style="text-align:right; ">1,500,000</td><td style="text-align:right; ">500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="text-align:right; ">12/09/2008</td><td style="text-align:right; ">2016</td><td >DEF Ltd</td><td >Sally Taylor</td><td style="text-align:right; ">10,000,000</td><td style="text-align:right; ">2,500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="text-align:right; ">12/09/2008</td><td style="text-align:right; ">1569</td><td >EFG Ltd</td><td >Bruce Hort</td><td style="text-align:right; ">750,000</td><td style="text-align:right; ">250</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="text-align:right; ">14/09/2008</td><td style="text-align:right; ">1571</td><td >FGH Ltd</td><td >Paul Rossiter</td><td style="text-align:right; ">150,000</td><td style="text-align:right; ">150</td></tr></table> <br />Excel tables to the web - Excel Jeanie Html 4

<b>Sheet2</b><br /><br /><table border="1" cellspacing="0" cellpadding="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:75px;" /><col style="width:51px;" /><col style="width:65px;" /><col style="width:97px;" /><col style="width:63px;" /><col style="width:35px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >Date</td><td >Facility</td><td >Company</td><td >Contact</td><td >Val1</td><td >Val2</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="text-align:right; ">10/09/2008</td><td style="text-align:right; ">52</td><td >ABC Ltd</td><td >Mike Ellis</td><td style="text-align:right; ">750000</td><td style="text-align:right; ">100</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="text-align:right; ">11/09/2008</td><td style="text-align:right; ">1052</td><td >BCD Ltd</td><td >Andrew Briggs</td><td style="text-align:right; ">500000</td><td style="text-align:right; ">500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="text-align:right; ">11/09/2008</td><td style="text-align:right; ">1053</td><td >BCD Ltd</td><td >Andrew Briggs</td><td style="text-align:right; ">500000</td><td style="text-align:right; ">500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="text-align:right; ">11/09/2008</td><td style="text-align:right; ">1054</td><td >BCD Ltd</td><td >Andrew Briggs</td><td style="text-align:right; ">500000</td><td style="text-align:right; ">500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="text-align:right; ">11/09/2008</td><td style="text-align:right; ">2015</td><td >CDE Ltd</td><td >Kiera Fryar</td><td style="text-align:right; ">1500000</td><td style="text-align:right; ">500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="text-align:right; ">11/09/2008</td><td style="text-align:right; ">2017</td><td >CDE Ltd</td><td >Kiera Fryar</td><td style="text-align:right; ">1500000</td><td style="text-align:right; ">500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td style="text-align:right; ">12/09/2008</td><td style="text-align:right; ">2016</td><td >DEF Ltd</td><td >Sally Taylor</td><td style="text-align:right; ">10000000</td><td style="text-align:right; ">2500</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td style="text-align:right; ">12/09/2008</td><td style="text-align:right; ">1569</td><td >EFG Ltd</td><td >Bruce Hort</td><td style="text-align:right; ">750000</td><td style="text-align:right; ">250</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td style="text-align:right; ">14/09/2008</td><td style="text-align:right; ">1571</td><td >FGH Ltd</td><td >Paul Rossiter</td><td style="text-align:right; ">150000</td><td style="text-align:right; ">150</td></tr></table> <br />Excel tables to the web - Excel Jeanie Html 4

 

[apo]

I just noticed a boo boo..

If you want the Values (Val1 and Val2) to ONLY appear next to the first row for each client.. change the Forr ii/Next ii block of code to this..

For ii = 1 To UBound(x, 2)
                    If ii = 2 Then
                        y(k, ii) = Trim(Split(x(cnt, 2), Chr(32))(j))
                    Else
                        If ii >= 5 And j > 0 Then
                            y(k, ii) = ""
                        Else
                            y(k, ii) = Trim(x(cnt, ii))
                        End If
                    End If
                Next ii