Help Needed for Groups Please

[Paul Black]

Hi Everyone,

I will try and explain simply what I would like to achieve.
I have a Macro that produces combinations and inserts them into the
Active Sheet. I ONLY want Combinations ( with 6 Letters in each
combination ) that appear in ANY Two Groups as Per the Grid ( the Grid
Structure could possibly change) below :-

Example Grid :-
Group 1 - A,F,K,O,S,W
Group 2 - B,G,L,P,T,X
Group 3 - C,H,M,Q,U,Y
Group 4 - D,I,N,R,V,Z
Group 5 - E,J

So A,K,W,P,M,Q and K,S,B,X,D,I would be EXCLUDED. In addition I would
also like to be able to, instead of having ALL Six Letters in ONLY ANY
Two Groups, maybe have the Option to put the Scenario - 4 Letters in
One Group and the Other Two Letters in ANY OTHER Two Groups for
example.
I want to have the different Groups Hard Coded ( so I can change them
) in the Macro and Exclude combinations that do NOT meet the Criteria.

A Very Big Thanks in Advance.
Paul

 

[Mark E. Philpot]

Gidday,
I doubt you will get a response from anyone. It is a bit
complex. Are you creating a game of a sort?
Anyway, if you would like to send me the workbook, with
the info, maybe I can devise something. As for answering
your question here: what was the question again? Doh!

regards

Mark
(e-mail address removed)

http://au.geocities.com/excelmarksway

 

[Paul Black]

If this is too complicated to do, does anyone have any ideas on an
alternative solution?.

Thanks in Advance
Paul

 

[Paul Black]

Hi again everyone,

I know the following Formula works in a SpreadSheet for what I am
trying to acieve :-

=IF(SUM(COUNTIF($A$1:$F$1,{A,F,K,O,S,W}))>4,"NOT
OK",IF(SUM(COUNTIF($A$1:$F$1,{B,G,L,P,T,X}))>4,"NOT
OK",IF(SUM(COUNTIF($A$1:$F$1,{C,H,M,Q,U,Y}))>4,"NOT
OK",IF(SUM(COUNTIF($A$1:$F$1,{D,I,N,R,V,Z}))>4,"NOT
OK",IF(SUM(COUNTIF($A$1:$F$1,{E,J}))>4,"NOT OK","OK")))))

What I am unable to do is to Translate this into VB Code, so it runs
through ALL the Combinations and ONLY outputs the Combinations to the
SpreadSheet that meet the Specific Criteria.
Any help would be appreciated.

Thanks in Advance
Paul

 

[Dave Peterson]

Ahhh. A question I understand! <vbg>.

You could loop through the cells in the range and count them manually. Or you
could just ask excel to do the same calculation as in your formula:

The second one seemed easier:

Option Explicit
Sub testme01()

Dim myRng As Range
Dim myArr As Variant
Dim iCtr As Long
Dim res As Long

myArr = Array("{""A"",""F"",""K"",""O"",""S"",""W""}", _
"{""B"",""G"",""L"",""P"",""T"",""X""}", _
"{""C"",""H"",""M"",""Q"",""U"",""Y""}", _
"{""D"",""I"",""N"",""R"",""V"",""Z""}", _
"{""E"",""J""}")

Set myRng = Worksheets("sheet1").Range("a1:f1")

myMsg = "Ok"
For iCtr = LBound(myArr) To UBound(myArr)
res = Evaluate("Sum(CountIf(" & myRng.Address(external:=True) _
& "," & myArr(iCtr) & "))")
If res > 4 Then
myMsg = "Not Ok"
Exit For
End If
Next iCtr

MsgBox myMsg
End Sub

ps. I think you wanted double quotes inside your worksheet formula, too:

=IF(SUM(COUNTIF($A$1:$F$1,{"A","F","K","O","S","W"}))>4,"NOT OK",
IF(SUM(COUNTIF($A$1:$F$1,{"B","G","L","P","T","X"}))>4,"NOT OK",
IF(SUM(COUNTIF($A$1:$F$1,{"C","H","M","Q","U","Y"}))>4,"NOT OK",
IF(SUM(COUNTIF($A$1:$F$1,{"D","I","N","R","V","Z"}))>4,"NOT OK",
IF(SUM(COUNTIF($A$1:$F$1,{"E","J"}))>4,"NOT OK","OK")))))

 

[Paul Black]

Hello Dave,

Thank you very much for your reply, it is most appreciated. To be
honest I was thinking that I was not going to get any responses at
all, not even those saying that this would be too complex to do.
This is exactly what I am after, but with one difference. I have a
Macro that Calculates ALL the Combinations in MEMORY and THEN inserts
them ( ignoring Combinations that do NOT meet Specific Criteria ) into
the Active Sheet starting at Cell A1.
I would like to be able to, instead of having ALL Six Letters in ONLY
ANY TWO Groups ( 4 in ANY ONE Group and the other TWO in ONE other
Group for example ), have the Flexibility to put the Scenario - 4 in
ONE Group and the Other TWO in ANY OTHER TWO Groups for example.
It will basically IGNORE the Combinations that do NOT meet the
Specific Criteria and so does NOT write those Combinations into the
Active Sheet.
I have set up a couple of simple Functions to ignore other Criteria,
and wondered if this could also be set up as a Function. It would be
nice for it to be as Flexible as possible so ANY Criteria could be
used regarding the Grid.

Once again, a very big thank you Peter.

All The Very Best
Paul

 

[Dave Peterson]

I'm not sure if I understand--well, I am sure and I don't understand <bg>.

But I didn't understand your original post until you translated it into a
worksheet formula.

Any chance you could do same kind of thing?

Maybe show some sample data and what should happen (plain text, though).

If you can explain it, maybe someone can help.

 

[Paul Black]

Hi Again Dave,

I am probably making this sound far more complicated than it is.
I have a Macro that has been written directly into a blank Module ( it
does NOT use ANY Data from a WorkSheet ). When I run it, it produces
"X" Number of Combinations that are then written directly to the
Active Sheet starting at cell A1.
I have already set up a couple of Functions with Specific Criteria
that reduces the Number of Combinations. If there were 10 Numbers and
6 Numbers were picked for each Combination there would be 210
Combinations, LESS any Combinations that DO NOT meet other set
Criteria.
What I am trying to achieve is that if I have certain groups of
Numbers like those below for example,

Group 1 - 1,6,11,15,19,23
Group 2 - 2,7,12,16,20,24
Group 3 - 3,8,13,17,21,25
Group 4 - 4,9,14,18,22,26
Group 5 - 5,10

which I would like Hard Coded into the Macro because they could and
probably will change from time to time.
I would like to be able to get the Macro to list ONLY those
Combinations that DO NOT meet certain Criteria. If I decided that I
ONLY wanted it to produce Combinations ( of 6 Numbers ) that are ONLY
in ANY TWO Groups ( i.e. 4 Numbers in ANY ONE Group and the OTHER TWO
Numbers in ONLY ONE OTHER Group ) then it would IGNORE ALL others. I
would like it to however, be flexible enough so that I can change that
Criteria to whatever I want. For example I might want it to ONLY
produce Combinations that have TWO Numbers in ANY THREE Groups or
THREE Numbers in ONE Group, TWO Numbers in ONE OTHER Group and the
Last Number in ONE OTHER Group

If I wanted 4 Numbers in ANY ONE Group and the OTHER TWO Numbers in
ONLY ONE OTHER Group then the Combination 2,4,7,9,12,16 would be fine,
but 2,3,4,7,12,16 would NOT.
If I wanted TWO Numbers in ANY THREE Groups then the Combination
2,3,4,7,8,9 would be fine, but 2,3,4,6,8,9 would NOT.
If I wanted THREE Numbers in ONE Group, TWO Numbers in ONE OTHER Group
and the Last Number in ONE OTHER Group then the Combination
1,3,5,6,8,11 would be fine, but 1,4,5,6,11,15 would NOT.

I hope I have been able to explain this a bit clearer.

Thank you very much for your time, patience and effort.
All the Very Best
Paul

 

[Dave Peterson]

I still don't understand it, but I think if I were approaching this, I'd put the
values in a worksheet. Then I could change them there (instead of the macro
code).

And maybe you could use those array formulas in that evaluate() sample code.
Return all the values and inspect each of the values to see how many matched.

If too many matched, you could ignore it.

Option Explicit
Sub testme()

Dim myVals(1 To 6) As Long
Dim iCtr As Long
Dim TotalMatches As Long
Dim myLimit As Long

'set these some how--separate evaluates????
myVals(1) = 3
myVals(2) = 4
myVals(3) = 4
myVals(4) = 5
myVals(5) = 4
myVals(6) = 1

myLimit = 3
TotalMatches = 0
For iCtr = LBound(myVals) To UBound(myVals)
If myVals(iCtr) > myLimit Then
TotalMatches = TotalMatches + 1
End If
Next iCtr

If TotalMatches > 2 Then
'do nothing
Else
'do something
End If

End Sub

 

[Paul Black]

Hi Dave,

I have listed the Code I am using below, hopefully this will make
things a bit clearer :-

Option Explicit
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim N As Long
Sub Combinations_626()
Range("A1").Select
Application.ScreenUpdating = False
N = 0
For A = 1 To 21
For B = A + 1 To 22
For C = B + 1 To 23
For D = C + 1 To 24
For E = D + 1 To 25
For F = E + 1 To 26
N = N + 1
If N = 65001 Then
N = 1
ActiveCell.Offset(-65000, 1).Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
ActiveCell.Value = A & "-" & B & "-" & C & "-" & D & "-" & E & "-" & F
ActiveCell.Offset(1, 0).Select
Next F
Next E
Next D
Next C
Next B
Next A
Application.ScreenUpdating = True
End Sub

This Macro produces 6 Number Combinations and puts then into the
Active Sheet starting at Cell A1.
Now it is just a matter of getting the Macro to IGNORE Combinations
that DO NOT meet the Specific Criteria in regard to Groups, as posted
above.

If the Groups were :-
Group 1 - 1,6,11,15,19,23
Group 2 - 2,7,12,16,20,24
Group 3 - 3,8,13,17,21,25
Group 4 - 4,9,14,18,22,26
Group 5 - 5,10

If I Wanted 4 Numbers in ANY ONE Group and the OTHER TWO Numbers in
ONLY ONE OTHER Group then the Combination 2,4,7,9,12,16 would be Fine,
but 2,3,4,7,12,16 would NOT.
If I Wanted TWO Numbers in ANY THREE Groups then the Combination
2,3,4,7,8,9 would be Fine, but 2,3,4,6,8,9 would NOT.
If I Wanted THREE Numbers in ONE Group, TWO Numbers in ONE OTHER Group
and the Last Number in ONE OTHER Group then the Combination
1,3,5,6,8,11 would be Fine, but 1,4,5,6,11,15 would NOT.

I hope I have managed to make this more understandable.

Thanks for All your help
Paul

 

[Dave Peterson]

This might be closer. First I created a new worksheet called Keys. This does
one of those keys at a time. If you need to combine them, maybe you could take
the previous routine and merge that in.

I put my 6 values in column A to column F (starting in row 1).

Option Explicit
Sub Combinations_626()

Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim oRow As Long
Dim oCol As Long
Dim myStr As String

Application.ScreenUpdating = False
With Worksheets.Add
oRow = 0
oCol = 1
For A = 1 To 21
For B = A + 1 To 22
For C = B + 1 To 23
For D = C + 1 To 24
For E = D + 1 To 25
For F = E + 1 To 26
myStr = "{" & A & "," & B & "," & C & "," & D _
& "," & E & "," & F & "}"
If checkVals(myStr, 4) = True Then
oRow = oRow + 1
If oRow = 65001 Then
oRow = oRow + 1
oCol = oCol + 1
End If
.Cells(oRow, oCol).Value = A & "-" & B _
& "-" & C & "-" & D & "-" & E & "-" & F
End If
Next F
Next E
Next D
Next C
Next B
Next A
End With
Application.ScreenUpdating = True

End Sub

Function checkVals(StrIn As String, MinToMatch As Long) As Boolean

Dim KeyWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long

Dim myRng As Range
Dim res As Long

Set KeyWks = Worksheets("keys")

With KeyWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
Set myRng = .Range(.Cells(iRow, "A"), _
.Cells(iRow, .Columns.Count).End(xlToLeft))

res = Evaluate("Sum(CountIf(" & myRng.Address(external:=True) _
& "," & StrIn & "))")

If res >= MinToMatch Then
Exit For
End If
Next iRow
End With

checkVals = CBool(res >= MinToMatch)

End Function

 

[Paul Black]

Hi Dave,

Thanks for the reply.
If I was to run the Macro I posted it would produce 230,230
Combinations starting at Cell A1.
A1 would have the First Combination, A2 the Second, A3 the Third etc.
Using the following Groups :-

Group 1 - 1,6,11,15,19,23
Group 2 - 2,7,12,16,20,24
Group 3 - 3,8,13,17,21,25
Group 4 - 4,9,14,18,22,26
Group 5 - 5,10

The Combinations would be :-
1-2-3-4-5-6 ( 2 in Group 1, 1 in Group 2, 1 in Group 3, 1 in Group 4 &
1 in Group 5 )
1-2-3-4-5-7 ( 1 in Group 1, 2 in Group 2, 1 in Group 3, 1 in Group 4 &
1 in Group 5 )
1-2-3-4-5-8 ( 1 in Group 1, 1 in Group 2, 2 in Group 3, 1 in Group 4 &
1 in Group 5 )
1-2-3-4-5-9 ( 1 in Group 1, 1 in Group 2, 1 in Group 3, 2 in Group 4 &
1 in Group 5 )
1-2-3-4-5-10 … ( 1 in Group 1, 1 in Group 2, 1 in Group 3, 1 in Group
4 & 2 in Group 5 )
Upto
21-22-23-24-25-26 ( 1 in Group 1, 1 in Group 2, 2 in Group 3 & 2 in
Group 4 )

What I am ideally looking for is Function that will EXCLUDE
Combinations NOT meeting Specific Criteria ( as previously posted ).

Once again, thank you for all your efforts.
All the Best
Paul

 

[Dave Peterson]

I'm still at a loss.

maybe...

Option Explicit
Sub Combinations_626()

Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim oRow As Long
Dim oCol As Long
Dim myStr As String

Application.ScreenUpdating = False
With Worksheets.Add
oRow = 0
oCol = 1
For A = 1 To 21
For B = A + 1 To 22
For C = B + 1 To 23
For D = C + 1 To 24
For E = D + 1 To 25
For F = E + 1 To 26
myStr = "{" & A & "," & B & "," & C & "," & D _
& "," & E & "," & F & "}"
If checkVals(myStr) = True Then
oRow = oRow + 1
If oRow = 65001 Then
oRow = oRow + 1
oCol = oCol + 1
End If
.Cells(oRow, oCol).Value = A & "-" & B _
& "-" & C & "-" & D & "-" & E & "-" & F
End If
Next F
Next E
Next D
Next C
Next B
Next A
End With
Application.ScreenUpdating = True

End Sub

Function checkVals(StrIn As String) As Boolean

Dim KeyWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim GroupTotal(1 To 6) As Long
Dim myCounts(0 To 6) As Long
Dim iCtr As Long

Dim myRng As Range
Dim res As Long

Set KeyWks = Worksheets("keys")

With KeyWks
FirstRow = 1
LastRow = 6

For iRow = FirstRow To LastRow
Set myRng = .Range(.Cells(iRow, "A"), _
.Cells(iRow, .Columns.Count).End(xlToLeft))

res = Evaluate("Sum(CountIf(" & myRng.Address(external:=True) _
& "," & StrIn & "))")

GroupTotal(iRow) = res

Next iRow
End With

'now you can inspect those 6 values to see which ones
'give the values you want.
For iCtr = LBound(myCounts) To UBound(myCounts)
If GroupTotal(iCtr) = iCtr Then
myCounts(iCtr) = myCounts(iCtr) + 1
End If
Next iCtr

'now mycounts give you a count for each group.
'do what you have to do to flunk the stuff you don't want.

End Function

myCounts will be the count of the number of matches. So mycounts(4) will mean
that there were 4 groups that matched.

I don't think I know enough to offer any more help.

good luck,

 

[Paul Black]

Hi Dave,

Thanks Again.
I tried Running the Macro and it came up with a Run Time Error '9' (
Subscript Out of Range ) on Line :-
If GroupTotal(iCtr) = iCtr Then

I am a Newbie to VB and am Unable to Resolve this Error.

I put some Letters in a Sheet Named "keys" ( Cells A1:F1 ) and just
Ran the Sub "testme01". It came up saying that "myMsg" had Not Been
Defined. I Defined it as a Variant ( is that Right ? ) and Ran it
again. It worked Fine.
I will look through what you have done and Try to Adapt it ( after I
can understand it ) so I can Include it into my Original Program. That
way the Combinations will be Excluded Before they are Written to the
Active Sheet.

Thanks and All the Best
Paul

 

[Dave Peterson]

This is one replacement:

For iCtr = LBound(GroupTotal) To UBound(GroupTotal)
If GroupTotal(iCtr) = iCtr Then
myCounts(iCtr) = myCounts(iCtr) + 1
End If
Next iCtr

Notice that the "for ictr" line changed to be based on grouptotal.

But I'm still not sure that's what you want.

And myMsg could have been declared as String
dim myMsg as String

 

[Dave Peterson]

This is what I really wanted to do:

For iCtr = LBound(GroupTotal) To UBound(GroupTotal)
myCounts(GroupTotal(iCtr)) = myCounts(GroupTotal(iCtr)) + 1
Next iCtr

After this loop completes, you'll now how many had 0 matches (mycounts(0)), how
many had 3 matches (mycounts(3)), to how many had 6 matches (mycounts(6)).

 

[Paul Black]

Hi Dave,

I think it is probably the way I am explaining what I am trying to
achieve that is causing the confusion.
I would really like to be able to do this.
Would it be a simpler solution to put the Groups into a Worksheet (
Named "Group Criteria" for example ) and then Modify the Macro ( I
posted ) I am using to lookup the Groups in the Worksheet ( Named
"Group Criteria ) and EXCLUDE Combinations that do NOT meet the
Criteria, so they are NOT written to the Worksheet ( Named
"Combinations" for example )?.

In a Sheet Named "Group Criteria" :-
Cell A1=Group 1, B1=1, C1=6, D1=11, E1=15, F1=19, G1=23
Cell A2=Group 2, B2=2, C2=7, D2=12, E2=16, F2=20, G2=24
Cell A3=Group 3, B3=3, C3=8, D3=13, E3=17, F3=21, G3=25
Cell A4=Group 4, B4=4, C4=9, D4=14, E4=18, F4=22, G4=26
Cell A5=Group 5, B5=5, C5=10

The Main Criteria I want is that there are NOT more than 4 Numbers in
ANY Combination of 6 Numbers from ANY ONE GROUP.
Doing it this way, would it be easier to set it up as a Function?.

BTW, I added the amendment you posted. When I ran it, it added a new
sheet but produced NO information.

Thanks Dave.
All the Best
Paul

 

[Dave Peterson]

That little portion at the end didn't do anything. It was a way to see how many
of each match were found.

But if you want to check if there are no more than 4 numbers in each match, you
could check to see if the 5th and 6th mycounts were greater than 0.




For iCtr = LBound(GroupTotal) To UBound(GroupTotal)
myCounts(GroupTotal(iCtr)) = myCounts(GroupTotal(iCtr)) + 1
Next iCtr

if mycounts(5) + mycounts(6) > 0 then
'too many
checkvals = false
else
checkvals = true
end if

right at the bottom of the checkvals function.