Help please

[Goldust]

I need to add a filter to my macro below;

Sub getcomb4() 'Line1

Dim a, b, c, d As Integer 'Line10

Dim count As Long 'Line20

Dim combin(2000) As String 'Line30

count = 0 'Line35

For a = 1 To 3 'Line40

For b = a + 1 To 4 'Line43

For c = b + 1 To 5 'Line46

For d = c + 1 To 6 'Line50

count = count + 1 'Line56

combin(count) = CStr(a) & "." & CStr(b) & "." & CStr(c) & "." & CStr(d) 'Line60


Next 'Line70

Next 'Line73

Next 'Line76

Next 'Line80

Range("A1").Select 'Line83

For count = 1 To 2000 'Line86

ActiveCell.Offset(count - 1, 0) = combin(count) 'Line90

Next 'Line93

End Sub 'Line96



The output is 15 lines of 4 numbers each in column A1:

1.2.3.4

1.2.3.5

1.2.3.6

1.2.4.5

1.2.4.6

1.2.5.6

1.3.4.5

1.3.4.6

1.3.5.6

1.4.5.6

2.3.4.5

2.3.4.6

2.3.5.6

2.4.5.6

3.4.5.6


The filter to be added:

Got 3 groups a , b and c

Group a got 4 nrs 1,2,3,4

Group b got 3 nrs 3,4,6

And group c got 2 nrs 4,6



I want 2 nrs from group a AND 2 nrs from group b

OR I want 2 nrs from group a AND 2 nrs from c

OR I want 2 nrs from group b AND 2 nrs from c

I should get 9 lines after running the macro:

1.2.3.4
1.2.4.6
1.3.4.5
1.3.4.6
1.4.5.6
2.3.4.5
2.3.4.6
2.4.5.6
3.4.5.6

These lines should have 3,4

Or 4,6

Or 3,4 and 4,6

Thanks

 

[Mankum]

Are you able to do this on excel?

 

[Goldust]

Are you able to do this on excel?

Thanks for the attention,
Yes, It is for excel

 

[Mankum]

Hi Goldust,

Please find below solution and do let me know if you face any issue -

Sub test()
Dim rng As Range
Dim cell As Range
Dim lstrow As Integer

Set rng = Sheet1.Range("A1:A" & Cells(Rows.count, 1).End(xlUp).Row)

For Each cell In rng

If cell.Value Like "*3*" And cell.Value Like "*4*" Or cell.Value Like "*4*" And cell.Value Like "*6*" Then
cell.Interior.Color = RGB(41, 247, 110)
End If

Next cell

rng.AutoFilter field:=1, Criteria1:=RGB(41, 247, 110), Operator:=xlFilterCellColor

End Sub

Thanks,
Manish

 

[Goldust]

Hi Manish,

Thanks a lot for the reply.

The output is correct.
However, I want 2 nrs from a and 2 numbers from grp b
or 2 nrs from a and 2 nrs from grp c...
I think it is better we mention the groups and tell to pick 2 nrs from each , take this combination of
4 numbers each, find the match if there is one and give it in the final output.
Please see if you can do it that way.

Once again thanks.
Stay safe

 

[Mankum]

Ok, Will try this and get back to you!

 

[Goldust]

Thank you

 

[Mankum]

Sub VBA1()
Dim lastDataRow As Integer
Dim startDataRow As Integer
Dim eachNameEndingRow As Integer
Dim concatinatedName As String
Dim concatinatedAddress As String
Dim i As Integer
Dim j As Integer


lastDataRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
startDataRow = 2

Do While startDataRow <= lastDataRow
eachNameEndingRow = Sheet1.Range("B" & startDataRow).End(xlDown).Row
MsgBox ("A" & " " & eachNameEndingRow - 1)
concatinatedName = ""
concatinatedAddress = ""
j = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1



'---------Name-----------
For i = startDataRow To eachNameEndingRow - 1
concatinatedName = concatinatedName & " " & Sheet1.Range("A" & i).Value
'MsgBox (concatinatedName)
Sheet2.Range("A" & j).Value = concatinatedName
Next i


'--------------Class
Sheet2.Range("B" & j).Value = Sheet1.Range("B" & startDataRow).Value



'----Address--------
For i = startDataRow To eachNameEndingRow - 1
concatinatedAddress = concatinatedAddress & " " & Sheet1.Range("C" & i).Value
'MsgBox (concatinatedName)
Sheet2.Range("C" & j).Value = concatinatedAddress
Next i

MsgBox (VBA.Trim(concatinatedName & vbNewLine & VBA.Trim(concatinatedAddress)))
startDataRow = eachNameEndingRow
Loop



End Sub

 

[Mankum]

Please ignore!!