Combine all products with different varieties

motilulla · Apr 8, 2019

Hello,

Combine all products with different varieties to achieve a special offer price package 

I am looking for a solution on how many special offer price packages can be prepared from the product and variety list of D5:F12, Note: there is Product A To H & Variety X To Z in the offer packages there must be all Products present from A To H one of each, but only one variety price can be chosen from X to Z 

Here are a few examples...
Column H if we make a lowest price offer package than we can pick the lowest price of one variety product and then combine it with one of each product A to H which can be the 135 $

Column J if we make a highest price offer package than we can pick the highest price of one variety product and than combine picking one of each product A to H which can be the 476 $

Made some offer price packages in Columns L, N, P, R, T and Y, question is how many special offer price packages can be prepared? Or in the range say 135$ to 199, 200$ to 299$, 300$ to 399$ or 400$ to 476$ may be?

Below is shown example data...

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

1

2

Min Offer Package

Max Offer Package

Offer Package

3

Variety X

Variety Y

Variety Z

Price $

4

Price $

135

476

157

212

243

311

334

392

5

Product A

9

13

78

9

78

13

9

78

6

Product B

23

34

43

23

43

23

43

23

7

Product C

5

84

11

5

84

5

11

84

8

Product D

59

26

15

59

26

15

59

26

59

9

Product E

12

20

68

12

68

12

68

20

10

Product F

27

33

40

27

40

27

40

27

11

Product G

33

32

35

32

35

32

35

32

33

32

12

Product H

12

69

19

12

69

19

69

12

69

Sheet2

Thanks In Advance 
Using version 2000

Regards,
Moti

Marcelo Branco · Apr 14, 2019

Maybe this macro...

Code:

Sub aTest()
    Dim pa As Variant, pb As Variant, pc As Variant, pd As Variant
    Dim pe As Variant, pf As Variant, pg As Variant, ph As Variant
    Dim i As Long, j As Long, k As Long, l As Long
    Dim m As Long, n As Long, o As Long, p As Long
    Dim myArr(1 To 8), dic As Object, lInd As Long
    
    pa = Range("D5:F5")
    pb = Range("D6:F6")
    pc = Range("D7:F7")
    pd = Range("D8:F8")
    pe = Range("D9:F9")
    pf = Range("D10:F10")
    pg = Range("D11:F11")
    ph = Range("D12:F12")
    
    Set dic = CreateObject("Scripting.Dictionary")
    lInd = 4
    For i = 1 To 3
      For j = 1 To 3
        For k = 1 To 3
          For l = 1 To 3
            For m = 1 To 3
              For n = 1 To 3
                For o = 1 To 3
                  For p = 1 To 3
                    myArr(1) = pa(1, i)
                    myArr(2) = pb(1, j)
                    myArr(3) = pc(1, k)
                    myArr(4) = pd(1, l)
                    myArr(5) = pe(1, m)
                    myArr(6) = pf(1, n)
                    myArr(7) = pg(1, o)
                    myArr(8) = ph(1, p)
                    lInd = lInd + 1
                    dic(lInd) = myArr
                  Next p
                Next o
              Next n
            Next m
          Next l
        Next k
      Next j
    Next i
    
    Range("I5").Resize(dic.Count, 8) = Application.Transpose(Application.Transpose(dic.items))
    With Range("Q5:Q" & lInd)
        .Formula = "=SUM(I5:P5)"
        .Value = .Value
    End With
    'Optional - sort ascending
    SortResults lInd
End Sub

Sub SortResults(lr As Long)
    Range("I4:Q" & lr).Sort key1:=Range("Q4"), order1:=xlAscending, Header:=xlYes
End Sub

Hope this helps

M.

motilulla · Apr 15, 2019

Marcelo Branco said:

Maybe this macro...

Code:

Sub aTest()
    Dim pa As Variant, pb As Variant, pc As Variant, pd As Variant
    Dim pe As Variant, pf As Variant, pg As Variant, ph As Variant
    Dim i As Long, j As Long, k As Long, l As Long
    Dim m As Long, n As Long, o As Long, p As Long
    Dim myArr(1 To 8), dic As Object, lInd As Long
    
    pa = Range("D5:F5")
    pb = Range("D6:F6")
    pc = Range("D7:F7")
    pd = Range("D8:F8")
    pe = Range("D9:F9")
    pf = Range("D10:F10")
    pg = Range("D11:F11")
    ph = Range("D12:F12")
    
    Set dic = CreateObject("Scripting.Dictionary")
    lInd = 4
    For i = 1 To 3
      For j = 1 To 3
        For k = 1 To 3
          For l = 1 To 3
            For m = 1 To 3
              For n = 1 To 3
                For o = 1 To 3
                  For p = 1 To 3
                    myArr(1) = pa(1, i)
                    myArr(2) = pb(1, j)
                    myArr(3) = pc(1, k)
                    myArr(4) = pd(1, l)
                    myArr(5) = pe(1, m)
                    myArr(6) = pf(1, n)
                    myArr(7) = pg(1, o)
                    myArr(8) = ph(1, p)
                    lInd = lInd + 1
                    dic(lInd) = myArr
                  Next p
                Next o
              Next n
            Next m
          Next l
        Next k
      Next j
    Next i
    
    Range("I5").Resize(dic.Count, 8) = Application.Transpose(Application.Transpose(dic.items))
    With Range("Q5:Q" & lInd)
        .Formula = "=SUM(I5:P5)"
        .Value = .Value
    End With
    'Optional - sort ascending
    SortResults lInd
End Sub

Sub SortResults(lr As Long)
    Range("I4:Q" & lr).Sort key1:=Range("Q4"), order1:=xlAscending, Header:=xlYes
End Sub

Hope this helps

M.

Marcelo Branco,

ray: I am very gratefully to you for looking my request and providing a VBA solution I really appreciate it. I was desperate needed to have it. 

I am sure it is because of version 2000, code stuck at the line below. Please could you take a look?

Code:

 Range("I5").Resize(dic.Count, 8) = Application.Transpose(Application.Transpose(dic.items))

Thank you very much 

Kind Regards,
Moti

Marcelo Branco · Apr 15, 2019

See if this new version works in Excel 2000

Code:

Sub aTestV2()
    Dim pa As Variant, pb As Variant, pc As Variant, pd As Variant
    Dim pe As Variant, pf As Variant, pg As Variant, ph As Variant
    Dim i As Long, j As Long, k As Long, l As Long
    Dim m As Long, n As Long, o As Long, p As Long
    Dim myArr(1 To 8), lLin As Long
    
    pa = Range("D5:F5")
    pb = Range("D6:F6")
    pc = Range("D7:F7")
    pd = Range("D8:F8")
    pe = Range("D9:F9")
    pf = Range("D10:F10")
    pg = Range("D11:F11")
    ph = Range("D12:F12")
    
    lLin = 4
    For i = 1 To 3
      For j = 1 To 3
        For k = 1 To 3
          For l = 1 To 3
            For m = 1 To 3
              For n = 1 To 3
                For o = 1 To 3
                  For p = 1 To 3
                    myArr(1) = pa(1, i)
                    myArr(2) = pb(1, j)
                    myArr(3) = pc(1, k)
                    myArr(4) = pd(1, l)
                    myArr(5) = pe(1, m)
                    myArr(6) = pf(1, n)
                    myArr(7) = pg(1, o)
                    myArr(8) = ph(1, p)
                    lLin = lLin + 1
                    Range("I" & lLin).Resize(, 8) = myArr
                  Next p
                Next o
              Next n
            Next m
          Next l
        Next k
      Next j
    Next i
    
    With Range("Q5:Q" & lLin)
        .Formula = "=SUM(I5:P5)"
        .Value = .Value
    End With
    'Optional - sort ascending
    SortResults lLin
End Sub

Sub SortResults(lr As Long)
    Range("I4:Q" & lr).Sort key1:=Range("Q4"), order1:=xlAscending, Header:=xlYes
End Sub

M.

motilulla · Apr 15, 2019

Marcelo Branco said:

See if this new version works in Excel 2000

Code:

Sub aTestV2()
    Dim pa As Variant, pb As Variant, pc As Variant, pd As Variant
    Dim pe As Variant, pf As Variant, pg As Variant, ph As Variant
    Dim i As Long, j As Long, k As Long, l As Long
    Dim m As Long, n As Long, o As Long, p As Long
    Dim myArr(1 To 8), lLin As Long
    
    pa = Range("D5:F5")
    pb = Range("D6:F6")
    pc = Range("D7:F7")
    pd = Range("D8:F8")
    pe = Range("D9:F9")
    pf = Range("D10:F10")
    pg = Range("D11:F11")
    ph = Range("D12:F12")
    
    lLin = 4
    For i = 1 To 3
      For j = 1 To 3
        For k = 1 To 3
          For l = 1 To 3
            For m = 1 To 3
              For n = 1 To 3
                For o = 1 To 3
                  For p = 1 To 3
                    myArr(1) = pa(1, i)
                    myArr(2) = pb(1, j)
                    myArr(3) = pc(1, k)
                    myArr(4) = pd(1, l)
                    myArr(5) = pe(1, m)
                    myArr(6) = pf(1, n)
                    myArr(7) = pg(1, o)
                    myArr(8) = ph(1, p)
                    lLin = lLin + 1
                    Range("I" & lLin).Resize(, 8) = myArr
                  Next p
                Next o
              Next n
            Next m
          Next l
        Next k
      Next j
    Next i
    
    With Range("Q5:Q" & lLin)
        .Formula = "=SUM(I5:P5)"
        .Value = .Value
    End With
    'Optional - sort ascending
    SortResults lLin
End Sub

Sub SortResults(lr As Long)
    Range("I4:Q" & lr).Sort key1:=Range("Q4"), order1:=xlAscending, Header:=xlYes
End Sub

M.

Marcelo Branco, hats off to you this worked spot on, it generated total 6561 lines starting from minimum sum 135 to maximum 476 Perfectly! <o

></o

>
<o

></o

>
I appreciate your time taken to solve my request.

<o

></o

>
<o

></o

>
Could it be possible, instead of generating all minimum to maximum can we limit the range of sum. For example: generate 200 to 250 or any other range I can select from 135-476.<o

></o

>
<o

></o

>
Kind Regards,<o

></o

>
Moti

<o

></o

>

Marcelo Branco · Apr 15, 2019

You are welcome. Glad to help.
To select specific sum ranges try filtering the result

M.

motilulla · Apr 15, 2019

Marcelo Branco said:
You are welcome. Glad to help.
M.

Marcelo Branco, I am very happy with your code it has saved my lot of time and it has been very useful for my job work

Marcelo Branco said:
To select specific sum ranges try filtering the result
M.

Yes I tried as you said and got the required range filtered, to avoid this step I thought might be it could be restricted the range directly inside the code it self if not possible I am very much happy with current code solution 

Thank you once again for your replay 

I hope you have a great week

Kind Regards,
Moti

Marcelo Branco · Apr 15, 2019

To filter the results (after you have run the aTestV2 macro) try:
Assumes:
Data on Sheet1
Filtered Results in Sheet2

Sheet1
Criteria in A2: B2

	A	B
1	Lower	Higher
2	200	250

Leave S4 empty and insert this formula in S5
=AND(Q5>=$A$2,Q5<=$B$2)

	S
4
5	FALSE

Run this macro

Code:

Sub AdvFilter()
    Sheets("Sheet2").Activate
    Columns("A:I").ClearContents
    Sheets("Sheet1").Range("I4:Q6565").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Sheet1").Range("S4:S5"), CopyToRange:=Range("A1"), _
        Unique:=False
End Sub

M.

motilulla · Apr 15, 2019

Marcelo Branco said:
To filter the results (after you have run the aTestV2 macro) try:
Assumes:
Data on Sheet1
Filtered Results in Sheet2

Sheet1
Criteria in A2: B2

A

B

1

Lower

Higher

2

200

250

<TBODY>
</TBODY>

Leave S4 empty and insert this formula in S5
=AND(Q5>=$A$2,Q5<=$B$2)

S

4

5

FALSE

<TBODY>
</TBODY>

Run this macro

Code:

Sub AdvFilter() Sheets("Sheet2").Activate Columns("A:I").ClearContents Sheets("Sheet1").Range("I4:Q6565").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet1").Range("S4:S5"), CopyToRange:=Range("A1"), _ Unique:=False End Sub

M.

Marcelo Branco, I set the sheets as per your instructions and (after running the aTestV2 macro) I run AdvFilter macro it does not filter the range 200-250 as pre A2-B2 but it do copy all the result in the sheet2 with all sums starting A1 To I6562 I can't find what I am doing wrong. 

Do you have some suggestions? 

Kind Regards,
Moti

Marcelo Branco · Apr 15, 2019

Criteria in A2: B2 of Sheet1 (data sheet)
Did you insert the formula in S5 and leave S4 empty?

Worked perfectly for me - see below some results (i did not paste all rows..)

Sheet2

	A	B	C	D	E	F	G	H	I
1	Product A	Product B	Product C	Product D	Product E	Product F	Product G	Product H	Package Price
2	9	23	5	59	12	40	33	19	200
3	9	23	5	59	20	33	32	19	200
4	9	23	5	59	20	40	32	12	200
5	9	23	5	15	20	27	32	69	200
6	9	23	5	15	68	33	35	12	200
7	9	23	11	59	20	27	32	19	200
8	9	23	11	59	20	33	33	12	200
9	9	23	11	15	68	27	35	12	200
10	9	34	5	59	12	27	35	19	200
11	9	43	5	59	12	27	33	12	200
12	9	43	11	26	20	40	32	19	200
13	13	23	5	59	20	33	35	12	200
14	13	23	11	59	20	27	35	12	200
15	13	34	5	59	12	33	32	12	200
16	13	34	11	59	12	27	32	12	200
17	13	43	11	26	20	33	35	19	200
18	13	43	11	26	20	40	35	12	200
19	9	23	5	59	20	33	33	19	201
20	9	23	5	59	20	40	33	12	201
21	9	23	5	15	12	33	35	69	201
22	9	23	5	15	20	27	33	69	201
23	....	....	....	....	....	....	....	....	....

M.

motilulla · Apr 15, 2019

Marcelo Branco said:
Criteria in A2: B2 of Sheet1 (data sheet)
Did you insert the formula in S5 and leave S4 empty?

Worked perfectly for me - see below some results (i did not paste all rows..)

Sheet2

A

B

C

D

E

F

G

H

I

1

Product A

Product B

Product C

Product D

Product E

Product F

Product G

Product H

Package Price

2

9

23

5

59

12

40

33

19

200

3

9

23

5

59

20

33

32

19

200

4

9

23

5

59

20

40

32

12

200

5

9

23

5

15

20

27

32

69

200

6

9

23

5

15

68

33

35

12

200

7

9

23

11

59

20

27

32

19

200

8

9

23

11

59

20

33

33

12

200

9

9

23

11

15

68

27

35

12

200

10

9

34

5

59

12

27

35

19

200

11

9

43

5

59

12

27

33

12

200

12

9

43

11

26

20

40

32

19

200

13

13

23

5

59

20

33

35

12

200

14

13

23

11

59

20

27

35

12

200

15

13

34

5

59

12

33

32

12

200

16

13

34

11

59

12

27

32

12

200

17

13

43

11

26

20

33

35

19

200

18

13

43

11

26

20

40

35

12

200

19

9

23

5

59

20

33

33

19

201

20

9

23

5

59

20

40

33

12

201

21

9

23

5

15

12

33

35

69

201

22

9

23

5

15

20

27

33

69

201

23

....

....

....

....

....

....

....

....

....

<TBODY>
</TBODY>

M.

Marcelo Branco, some thing went wrong I just restart all again and create a new workbook all worked perfectly as you illustrate.

Marcelo, I am very sorry for the inconvenience, thank you for your advance filter idea which is innovative I like it. 

Good Luck have a good day

Kind Regards,
Moti

Combine all products with different varieties

motilulla

Well-known Member

Marcelo Branco

MrExcel MVP

Excel Facts

motilulla

Well-known Member

Marcelo Branco

MrExcel MVP

motilulla

Well-known Member

Marcelo Branco

MrExcel MVP

motilulla

Well-known Member

Marcelo Branco

MrExcel MVP

motilulla

Well-known Member

Marcelo Branco

MrExcel MVP

motilulla

Well-known Member

Similar threads

Forum statistics

Share this page

Combine all products with different varieties

Well-known Member

MrExcel MVP

Excel Facts

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

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