Is there a VBA solution for this?

itgirlxx

New Member
Joined
Dec 17, 2015
Messages
21
Source table:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Frame
[/TD]
[TD]Fabric
[/TD]
[TD]Size
[/TD]
[/TR]
[TR]
[TD]ATB
[/TD]
[TD]G901
[/TD]
[TD]C
[/TD]
[/TR]
[TR]
[TD]ATBN
[/TD]
[TD]G902
[/TD]
[TD]K
[/TD]
[/TR]
[TR]
[TD]FMB
[/TD]
[TD]G903
[/TD]
[TD]Q
[/TD]
[/TR]
[TR]
[TD]FMBN
[/TD]
[TD]G904
[/TD]
[TD]F
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]G905
[/TD]
[TD]T
[/TD]
[/TR]
</tbody>[/TABLE]

I would like to create 1 row in a new table for every combination of these 3 columns with a '-' separator between each value.
For example, for ATB, I need 1 row for each fabric in each of the 5 sizes, so 25 SKU's:
ATB-G901-C
ATB-G901-K
and so on until ATB-G905-T

This is just a very small snapshot of the true table.
In the true table there are close to 130 frames and 150 fabrics.

Many thanks in advance for any help given.
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Maybe try something like this.....

Data is on Sheet 1
Output goes on Sheet 2

Code:
[COLOR=#0000ff]Sub[/COLOR] Test()

    [COLOR=#0000ff]Dim[/COLOR] Col1LR  [COLOR=#0000ff]As Long[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] Col2LR  [COLOR=#0000ff]As Long[/COLOR]
 [COLOR=#0000ff]   Dim [/COLOR]Col3LR [COLOR=#0000ff] As Long[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] DataSht [COLOR=#0000ff]As[/COLOR] Worksheet
   [COLOR=#0000ff] Dim[/COLOR] MidLp   [COLOR=#0000ff]As Long[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] OuterLP[COLOR=#0000ff] As Long[/COLOR]
  [COLOR=#0000ff]  Dim [/COLOR]InnerLp [COLOR=#0000ff]As Long[/COLOR]
  [COLOR=#0000ff]  Dim[/COLOR] nRow    [COLOR=#0000ff]As Long[/COLOR]
    
    [COLOR=#0000ff]Set[/COLOR] DataSht = Sheets("Sheet1")
    
   [COLOR=#0000ff] With[/COLOR] DataSht
    Col1LR = .Range("A" & Rows.Count).End(xlUp).Row
    Col2LR = .Range("B" & Rows.Count).End(xlUp).Row
    Col3LR = .Range("C" & Rows.Count).End(xlUp).Row

     [COLOR=#0000ff]   For [/COLOR]OuterLP = 2 [COLOR=#0000ff]To[/COLOR] Col1LR
           [COLOR=#0000ff] For[/COLOR] MidLp = 2 [COLOR=#0000ff]To [/COLOR]Col2LR
              [COLOR=#0000ff]  For[/COLOR] InnerLp = 2 [COLOR=#0000ff]To[/COLOR] Col3LR
                    nRow = nRow + 1
                    Sheets("Sheet2").Cells(nRow, 1) = .Cells(OuterLP, 1) & "-" _
                                                       & .Cells(MidLp, 2) & "-" _
                                                       & .Cells(InnerLp, 3)
           [COLOR=#0000ff]     Next[/COLOR] InnerLp
         [COLOR=#0000ff]   Next [/COLOR]MidLp
       [COLOR=#0000ff] Next[/COLOR] OuterLP

[COLOR=#0000ff]    End With[/COLOR]

[COLOR=#0000ff]End Sub[/COLOR]
 
Last edited:
Upvote 0
I am not proficient with VBA so need very basic instructions on what to do with this code.
This is what I have done so far:
- opened my excel file
- Alt-F11 to open VB
- Insert - Module
- Pasted the code
- Saved the file as a macro-enabled file

Now what?
 
Upvote 0
I think I just figured it. I just ran the macro titled Sheet1:test
I assume that it will work in the same way when I add more rows to columns A and B?


I am not proficient with VBA so need very basic instructions on what to do with this code.
This is what I have done so far:
- opened my excel file
- Alt-F11 to open VB
- Insert - Module
- Pasted the code
- Saved the file as a macro-enabled file

Now what?
 
Upvote 0
Can you provide me with a 2nd solution if I have just 2 columns of data?
Source table:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Frame
[/TD]
[TD]Fabric
[/TD]
[/TR]
[TR]
[TD]ESO
[/TD]
[TD]G101
[/TD]
[/TR]
[TR]
[TD]PSO
[/TD]
[TD]G102
[/TD]
[/TR]
[TR]
[TD]GL1
[/TD]
[TD]G103
[/TD]
[/TR]
</tbody>[/TABLE]



I think I just figured it. I just ran the macro titled Sheet1:test
I assume that it will work in the same way when I add more rows to columns A and B?
 
Upvote 0
It's dynamic like you suggest:
I assume that it will work in the same way when I add more rows to columns A and B?

You will need this modification for only two rows of data....

Code:
[COLOR=#0000ff]Sub [/COLOR]Test()


[COLOR=#0000ff]    Dim[/COLOR] Col1LR  [COLOR=#0000ff]As Long[/COLOR]
  [COLOR=#0000ff]  Dim [/COLOR]Col2LR  [COLOR=#0000ff]As Long[/COLOR]
[COLOR=#0000ff]    Dim [/COLOR]DataSht As Worksheet
[COLOR=#0000ff]    Dim[/COLOR] MidLp  [COLOR=#0000ff] As Long[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] OuterLP [COLOR=#0000ff]As Long[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] nRow    [COLOR=#0000ff]As Long[/COLOR]
[COLOR=#0000ff]    [/COLOR]
[COLOR=#0000ff]    Set[/COLOR] DataSht = Sheets("Sheet1")[COLOR=#008000] 'Set Data Sheet[/COLOR]
    
[COLOR=#0000ff]    With [/COLOR]DataSht
    Col1LR = .Range("A" & Rows.Count).End(xlUp).Row [COLOR=#008000]'Define last row in Column A[/COLOR]
    Col2LR = .Range("B" & Rows.Count).End(xlUp).Row [COLOR=#008000]'Define last row in Column B[/COLOR]

 [COLOR=#008000]       'Loop through all possible outcomes[/COLOR]
[COLOR=#0000ff]        For [/COLOR]OuterLP = 2 [COLOR=#0000ff]To [/COLOR]Col1LR
 [COLOR=#0000ff]           For [/COLOR]MidLp = 2[COLOR=#0000ff] To[/COLOR] Col2LR
              
                    nRow = nRow + 1
                    Sheets("Sheet2").Cells(nRow, 1) = .Cells(OuterLP, 1) & "-" _
                                                       & .Cells(MidLp, 2)[COLOR=#008000] 'Input Value on Sheet2[/COLOR]
[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]            Next [/COLOR]MidLp
[COLOR=#0000ff]        Next [/COLOR]OuterLP


[COLOR=#0000ff]    End With[/COLOR]
[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]End Sub[/COLOR]
Make Sure Sheets Are named exact: "Sheet1" and "Sheet2"
Open VBE Alt + F11
CLick on Insert > Module
Insert Code in Module
Hit F5 Key

Please let me know if you have any questions. Glad to help.
 
Upvote 0

Forum statistics

Threads
1,223,632
Messages
6,173,472
Members
452,516
Latest member
archcalx

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