Help please

Goldust

New Member
Joined
May 15, 2020
Messages
4
Office Version
2010
Platform
Windows
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
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Mankum

New Member
Joined
May 4, 2020
Messages
15
Office Version
365
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

New Member
Joined
May 15, 2020
Messages
4
Office Version
2010
Platform
Windows
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
 

Goldust

New Member
Joined
May 15, 2020
Messages
4
Office Version
2010
Platform
Windows
Thank you
 

Mankum

New Member
Joined
May 4, 2020
Messages
15
Office Version
365
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
 

Watch MrExcel Video

Forum statistics

Threads
1,095,731
Messages
5,446,181
Members
405,390
Latest member
RafalKowalski

This Week's Hot Topics

Top