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

R

Rygaard

New Member
Joined
Jan 28, 2015
Messages
11
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:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Order[/TD]
[TD]part1[/TD]
[TD]part2[/TD]
[TD]par3[/TD]
[TD]Numbers[/TD]
[/TR]
[TR]
[TD]S001[/TD]
[TD]X[/TD]
[TD][/TD]
[TD]x[/TD]
[TD]24[/TD]
[/TR]
[TR]
[TD]S009[/TD]
[TD][/TD]
[TD]x[/TD]
[TD][/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]S011[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]S115[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]10[/TD]
[/TR]
</tbody>[/TABLE]

This i need to get to this form:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Order[/TD]
[TD]part[/TD]
[TD]number[/TD]
[/TR]
[TR]
[TD]S001[/TD]
[TD]part1[/TD]
[TD]24[/TD]
[/TR]
[TR]
[TD]S001[/TD]
[TD]Part3[/TD]
[TD]24[/TD]
[/TR]
[TR]
[TD]S009[/TD]
[TD]Part2[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]S011[/TD]
[TD]part1[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]S011[/TD]
[TD]Part2[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]S011[/TD]
[TD]Part3[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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 ?
 
Last edited:

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
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
 
Upvote 0
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 !
 
Upvote 0
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
Click to expand...
Ref Quote above:- Are you saying that the results for number "S001" should be as below

[TABLE="width: 236"]
<colgroup><col width="27" style="width: 20pt; mso-width-source: userset; mso-width-alt: 967;"> <col width="93" style="width: 70pt; mso-width-source: userset; mso-width-alt: 3299;"> <col width="89" style="width: 67pt; mso-width-source: userset; mso-width-alt: 3157;"> <col width="105" style="width: 79pt; mso-width-source: userset; mso-width-alt: 3726;"> <tbody>[TR]
[TD="class: xl63, width: 27, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAEEF3]#DAEEF3[/URL] "] [/TD]
[TD="class: xl63, width: 93, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAEEF3]#DAEEF3[/URL] "]A[/TD]
[TD="class: xl63, width: 89, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAEEF3]#DAEEF3[/URL] "]B[/TD]
[TD="class: xl63, width: 105, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAEEF3]#DAEEF3[/URL] "]C[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAEEF3]#DAEEF3[/URL] , align: right"]1[/TD]
[TD="class: xl65, width: 93, bgcolor: #DCE6F1"]Order[/TD]
[TD="class: xl65, width: 89, bgcolor: #DCE6F1"]part[/TD]
[TD="class: xl65, width: 105, bgcolor: #DCE6F1"]number[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAEEF3]#DAEEF3[/URL] , align: right"]2[/TD]
[TD="class: xl64, width: 93, bgcolor: white"]S001[/TD]
[TD="class: xl64, width: 89, bgcolor: white"]part1[/TD]
[TD="class: xl64, width: 105, bgcolor: white"]2.5[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAEEF3]#DAEEF3[/URL] , align: right"]3[/TD]
[TD="class: xl66, width: 93, bgcolor: #DCE6F1"]S001[/TD]
[TD="class: xl66, width: 89, bgcolor: #DCE6F1"]Part3[/TD]
[TD="class: xl66, width: 105, bgcolor: #DCE6F1"]21.5[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
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 :) )
 
Upvote 0
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
 
Upvote 0
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 [TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"] =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 [TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"] =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 [TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"] =INDEX($E$2:$E$5,MATCH($A7,$A$2:$A$5,0))


[TABLE="width: 320"]
<colgroup><col width="64" span="5" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]order[/TD]
[TD="width: 64"]Part1[/TD]
[TD="width: 64"]Part2[/TD]
[TD="width: 64"]Part3[/TD]
[TD="width: 64"]Numbers[/TD]
[/TR]
[TR]
[TD]a[/TD]
[TD]x[/TD]
[TD][/TD]
[TD]x[/TD]
[TD="align: right"]24[/TD]
[/TR]
[TR]
[TD]b[/TD]
[TD][/TD]
[TD]x[/TD]
[TD][/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]c[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD="align: right"]15[/TD]
[/TR]
[TR]
[TD]d[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]a[/TD]
[TD]Part1[/TD]
[TD="align: right"]24[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]a[/TD]
[TD]Part1[/TD]
[TD="align: right"]24[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]b[/TD]
[TD]Part2[/TD]
[TD="align: right"]10[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]c[/TD]
[TD]Part1[/TD]
[TD="align: right"]15[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]c[/TD]
[TD]Part1[/TD]
[TD="align: right"]15[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]c[/TD]
[TD]Part1[/TD]
[TD="align: right"]15[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
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 :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
Call a macro based on text in column C (same row that is active).
Replies
8
Views
131
6StringJazzer
6StringJazzer
T
  • Question Question
VBA to copy over manual entry cells that are adjacent to imported data
Replies
0
Views
634
TheGrandPooba
T
K
  • Solved
Macro to extract data into seperate workbooks
2
Replies
11
Views
636
Alex Blakenburg
A
PuntingJawa
  • Question Question
How to print multiple sheets from data on another sheet
Replies
0
Views
307
PuntingJawa
PuntingJawa
T
  • Solved
loop macro only bringing back 1 row of data...
Replies
3
Views
318
StephenCrump
S

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top