Lines with data need to become multiple lines with only 1 entry pr line for import in ERP system

Rygaard · Jul 28, 2017

So... i have a sheet with a lot of lines and for each line I have between 0 and 5 information's (one in its own column) i need to spread out so only 1 column.

Eksample:

Order	part1	part2	par3	Numbers
S001	X		x	24
S009		x		10
S011	x	x	x	15
S115				10

This i need to get to this form:

Order	part	number
S001	part1	24
S001	Part3	24
S009	Part2	10
S011	part1	15
S011	Part2	15
S011	Part3	15

I think im ½ the way

First i made a Macro that filled in extra lines based on a count of how may cells in a row had X ( this i do in column P) - So for order S001 I auto generated 1 new line and took all data in other columns and pasted it down:

Code:

Sub Insert()    Dim End_Row As Long, n As Long, Ins As Long
    End_Row = Range("P" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    For n = End_Row To 1 Step -1


        Ins = Cells(n, "P").Value


        If Ins > 1 Then
            Range("P" & n + 1 & ":P" & n + Ins - 1).EntireRow.Insert
        Range(Cells(n, 1), Cells(n + Ins - 1, "P")).FillDown
        Range(Cells(n, 1), Cells(n + Ins - 1, "Q")).FillDown
        Range(Cells(n, 1), Cells(n + Ins - 1, "R")).FillDown
        Range(Cells(n, 1), Cells(n + Ins - 1, "S")).FillDown
        Range(Cells(n, 1), Cells(n + Ins - 1, "T")).FillDown
        Range(Cells(n, 1), Cells(n + Ins - 1, "U")).FillDown
        Range(Cells(n, 1), Cells(n + Ins - 1, "V")).FillDown
        ' Det her virker desvære ikke
        ' ElseIf Ins < 0 Then
        ' Range("P" & n + 1 & ":P" & n + Ins - 1).EntireRow.Delete
        
        End If


    Next n
    Application.ScreenUpdating = True
End Sub

My problem now is ... how to i make it take part 1 ... skip the blank Part 2.. and then take part 3 ?

MickG · Jul 28, 2017

You may like to try this for results on sheet2.

Code:

[COLOR="Navy"]Sub[/COLOR] MG28Jul48
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, k [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
    Ray = Cells(1).CurrentRegion
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]For[/COLOR] ac = 2 To UBound(Ray, 2) - 1
        [COLOR="Navy"]If[/COLOR] UCase(Ray(n, ac)) = "X" [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 1)).exists(Ray(1, ac)) [COLOR="Navy"]Then[/COLOR]
                Dic(Ray(n, 1)).Add Ray(1, ac), Ray(n, UBound(Ray, 2))
            [COLOR="Navy"]Else[/COLOR]
                Q = Dic(Ray(n, 1)).Item(Ray(n, ac))
                Q = Q + Ray(n, UBound(Ray, 2))
                Dic(Ray(n, 1)).Item(Ray(n, ac)) = Q
            [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] n
   
   
  ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
  nray(1, 1) = "Order": nray(1, 2) = "Part": nray(1, 3) = "Number"
  c = 1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
       [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
          c = c + 1
          nray(c, 1) = k: nray(c, 2) = p: nray(c, 3) = Dic(k).Item(p)
       [COLOR="Navy"]Next[/COLOR] p
   [COLOR="Navy"]Next[/COLOR] k
 [COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 3)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
 [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Rygaard · Jul 31, 2017

This worked, and the more you know ... the more precise Questions you can ask - so your answer leads me to a new question - a more precise one.

what if i have the Number instead of an X
so for order S001 Under Part1 I have 2,5 and under Part3 i have 21,5

Because i just realized that some of the orders have a different Number total, than the individual parts -

if it is not possible, or to hard to code, i can do it by hand, this is still a HUGE help - But we need to enter data every week, and each ordre sheet in excel is like 400 orders long so if it is at all possible to automatize the whole thing - it would save so much time.

once more .. thank you for what you have already done !

MickG · Aug 1, 2017

what if i have the Number instead of an X
so for order S001 Under Part1 I have 2,5 and under Part3 i have 21,5

Ref Quote above:- Are you saying that the results for number "S001" should be as below

	A	B	C
1	Order	part	number
2	S001	part1	2.5
3	S001	Part3	21.5

Rygaard · Aug 1, 2017

yes -
thank you - im sorry i did not formulate my original question correct, but i did not know what the answer would look like.

Hello MickG
Also right now i can see that i can type any headline on sheet 1, and it will just fill that in on sheet 2 - this is perfect - and way better that what i could have thought of (also that it shows results on sheet2 is Perfect! - it is clear that I did not have the experience to even formulate what I really wanted .

I have just tested the result you show... and it work for the import part

Also the "part1" or "part3" - the way it work now i can write the item number eg. Part1 = item number 8341 this work now - witch is Perfect !

(on a side note I appreciate the choice of naming of objects and variants - I wont change a thing

)

MickG · Aug 1, 2017

On the basis of "Yes" try this:-
Results on sheet2.

Code:

[COLOR="Navy"]Sub[/COLOR] MG01Aug59
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, k [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
    Ray = Cells(1).CurrentRegion
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]For[/COLOR] ac = 2 To UBound(Ray, 2) - 1
        [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(n, ac)) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 1)).exists(Ray(1, ac)) [COLOR="Navy"]Then[/COLOR]
                Dic(Ray(n, 1)).Add Ray(1, ac), Ray(n, ac)
            [COLOR="Navy"]Else[/COLOR]
                Q = Dic(Ray(n, 1)).Item(Ray(n, ac))
                Q = Q + Ray(n, ac)
                Dic(Ray(n, 1)).Item(Ray(n, ac)) = Q
            [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] n
   
   
  ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
  nray(1, 1) = "Order": nray(1, 2) = "Part": nray(1, 3) = "Number"
  c = 1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
       [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
          c = c + 1
          nray(c, 1) = k: nray(c, 2) = p: nray(c, 3) = Dic(k).Item(p)
       [COLOR="Navy"]Next[/COLOR] p
   [COLOR="Navy"]Next[/COLOR] k
 [COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 3)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
 [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Mike Szczesny · Aug 1, 2017

Can you use something like this? I made a small example base on your requirements. I have three formulas for your three results. I also included =iferror(...." ") to remove error messages. You need to enter with Cntrl+Shift+Enter. Then copy. Make sure you have the right cell references set up in your formulas. Assume my data sample is in A1:E5. My formula results are in A7, B7, and C7. The formula is A7 is

=IFERROR(INDEX($A$2:$A$5,SMALL(IF($B$2:$D$5="x",ROW($B$2:$D$5)-ROW($B$2)+1),ROWS($A$7:A7)))," ")
The formula in B7 is

=IFERROR(INDEX($B$1:$D$1,SMALL(IF($B$2:$D$5="x",IF($A$2:$A$5=$A7,COLUMN($B$2:$D$5)-COLUMN($B$2)+1)),COUNTIF($A7:A7,$A7)))," ")
The formula in C7 is

=INDEX($E$2:$E$5,MATCH($A7,$A$2:$A$5,0))

order	Part1	Part2	Part3	Numbers
a	x		x	24
b		x		10
c	x	x	x	15
d				10

a	Part1	24
a	Part1	24
b	Part2	10
c	Part1	15
c	Part1	15
c	Part1	15

Rygaard · Aug 2, 2017

MickG - That worked PERFECT - thank you so very much

@Mike Szczesny - thank you also, i will go with the solution MickG postede - but thank you for your time ( ill save this formula for later use )

once more.. THANK you

MickG · Aug 2, 2017

You're welcome

Lines with data need to become multiple lines with only 1 entry pr line for import in ERP system

Rygaard

New Member

Excel Facts

MickG

MrExcel MVP

Rygaard

New Member

MickG

MrExcel MVP

Rygaard

New Member

MickG

MrExcel MVP

Mike Szczesny

Active Member

Rygaard

New Member

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

Lines with data need to become multiple lines with only 1 entry pr line for import in ERP system

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

Active Member

New Member

MrExcel MVP

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