Search for topics based on their groups.

[harzer]

Hello everyone,
I submit to you my problem that I do not know how to go about solving it, I will explain to you and I will give you the details to resolve it:
In my "Growth" sheet, I have 16 groups of 3 lines, each group has the group number which is in column "A", in my example (here) each group has 3 lines, it can happen that the group has 4 lines.
For greater visibility of the various groups, I colored each group a different color.
The work that I am asking you to do (in vba please) consists of finding in which group all the subjects in column "F" are located.
To better explain the approach to implement, we will take an example, this is the first subject found in cell “F2”: AE27-022/2022 M
We will look for the groups where the value of cell "F2" (AE27-022/2022 M) is located, to begin with, it is found in cell "F2" which is located in group 1, if continue to search for this value in column "F", we also find it in cell "F20" which is in group 7, and we find it in cell "F30" which is in group 10.
In summary, the value of cell "F2" is found in the groups: 1 - 7 - 10, we can then mark the numbers of the groups separated by a hyphen (-) in cell "J2" = 1 - 7 - 10
2nd example, we will look for the groups of the subject which is located in cell "F3" = (5919-001/2023 M), the groups for this subject are: 1 - 11 - 13, we can then mark the numbers of the groups separated by a hyphen (-) in cell "J3" = 1 - 11 – 13
We recommend doing the same for all subjects in column "F" and marking the groups in column "J" on the same line of the subject sought.
Unless I'm mistaken, I have put the results for all subjects in column "J".
I hope I was clear enough in my explanations, otherwise, I remain at your disposal for other additional information.
Thank you for your propositions.

Classeur1
	A	B	C	D	E	F	G	H	I	J
1	Groupes	Femelle	Père	Mère	13	Mâle	Père	Mère		Groupes
2	1	MN96-010/2021 F	MN96-002/2020 M	MN96-020/2020 F		AE27-022/2022 M	AE27-049/2021 M	AE27-003/2021 F		1 - 7 - 10
3						5919-001/2023 M	3024-058/2020 M	3024-011/2022 F		1 - 11 - 13
4
5	2	MN96-034/2021 F	MN96-050/2020 M	MN96-013/2019 F		AE27-035/2022 M	MN96-005/2021 M	AE27-068/2021 F		2 - 8
6						AE27-069/2023 M	AE27-018/2022 M	MN96-045/2022 F		2 - 3 - 4 - 8
7						MN96-008/2021 M	MN96-002/2020 M	MN96-020/2020 F		2 - 3 - 4 - 5 - 6 - 16
8	3	AE27-026/2022 F	MN96-046/2019 M	MN96-036/2021 F		AE27-069/2023 M	AE27-018/2022 M	MN96-045/2022 F		3 - 4 - 8 - 2
9						MN96-008/2021 M	MN96-002/2020 M	MN96-020/2020 F		3 - 4 - 5 - 6 - 16 - 2
10						AE27-033/2022 M	AE27-010/2021 M	MN96-034/2021 F		3 - 4 - 12
11	4	AE27-037/2022 F	MN96-005/2021 M	AE27-068/2021 F		AE27-033/2022 M	AE27-010/2021 M	MN96-034/2021 F		4 - 12 - 3
12						MN96-008/2021 M	MN96-002/2020 M	MN96-020/2020 F		4 - 5 - 6 - 16 - 2 - 3
13						AE27-069/2023 M	AE27-018/2022 M	MN96-045/2022 F		4 - 8 - 2 - 3
14	5	AE27-038/2022 F	MN96-005/2021 M	AE27-068/2021 F		MN96-020/2023 M	MN96-011/2022 M	MN96-020/2021 F		5 - 6 - 9
15						AE27-010/2021 M	AE27-015/2020 M	AE27-021/2020 F		5 - 11 - 16
16						MN96-008/2021 M	MN96-002/2020 M	MN96-020/2020 F		5 - 6 - 16 - 2 - 3 - 4
17	6	MN96-045/2022 F	MN96-002/2020 M	MN96-020/2020 F		AE27-036/2023 M	MN96-024/2021 M	AE27-011/2022 F		6 - 14
18						MN96-020/2023 M	MN96-011/2022 M	MN96-020/2021 F		6 - 9 - 5
19						MN96-008/2021 M	MN96-002/2020 M	MN96-020/2020 F		6 - 16 - 2 - 3 - 4 - 5
20	7	MN96-007/2023 F	MN96-014/2022 M	MN96-021/2021 F		AE27-022/2022 M	AE27-049/2021 M	AE27-003/2021 F		7 - 10 - 1
21						3024-060/2023 M	3024-066/2020 M	2207-032/2020 F		7 - 12 - 13
22
23	8	AE27-009/2023 F	AE27-022/2022 M	MN96-010/2021 F		AE27-018/2022 M	MN96-005/2021 M	AE27-068/2021 F		8 - 15
24						AE27-035/2022 M	MN96-005/2021 M	AE27-068/2021 F		8 - 2
25						AE27-069/2023 M	AE27-018/2022 M	MN96-045/2022 F		8 - 2 - 3 - 4
26	9	AE27-010/2023 F	AE27-022/2022 M	MN96-010/2021 F		AE27-019/2022 M	MN96-005/2021 M	AE27-068/2021 F		9 - 14 - 16
27						MN96-020/2023 M	MN96-011/2022 M	MN96-020/2021 F		9 - 5 - 6
28
29	10	AE27-015/2023 F	MN96-008/2021 M	AE27-037/2022 F		AE27-022/2023 M	AE27-022/2022 M	MN96-010/2021 F		10 - 15
30						AE27-022/2022 M	AE27-049/2021 M	AE27-003/2021 F		10 - 1 - 7
31
32	11	AE27-017/2023 F	MN96-008/2021 M	AE27-037/2022 F		AE27-010/2021 M	AE27-015/2020 M	AE27-021/2020 F		11 - 16 - 5
33						5919-001/2023 M	3024-058/2020 M	3024-011/2022 F		11 - 13 - 1
34
35	12	AE27-019/2023 F	AE27-022/2022 M	MN96-010/2021 F		3024-060/2023 M	3024-066/2020 M	2207-032/2020 F		12 - 13 - 7
36						AE27-033/2022 M	AE27-010/2021 M	MN96-034/2021 F		12 - 3 - 4
37
38	13	AE27-020/2023 F	AE27-022/2022 M	MN96-010/2021 F		5919-001/2023 M	3024-058/2020 M	3024-011/2022 F		13 - 1 - 11
39						3024-060/2023 M	3024-066/2020 M	2207-032/2020 F		13 - 7 - 12
40
41	14	AE27-023/2023 F	AE27-022/2022 M	MN96-010/2021 F		AE27-036/2023 M	MN96-024/2021 M	AE27-011/2022 F		14 - 6
42						AE27-019/2022 M	MN96-005/2021 M	AE27-068/2021 F		14 - 16 -9
43
44	15	MN96-027/2023 F	AE27-001/2022 M	MN96-043/2022 F		AE27-022/2023 M	AE27-022/2022 M	MN96-010/2021 F		15 - 10
45						AE27-018/2022 M	MN96-005/2021 M	AE27-068/2021 F		15 - 8
46
47	16	AE27-055/2023 F	MN96-046/2019 M	MN96-010/2021 F		MN96-008/2021 M	MN96-002/2020 M	MN96-020/2020 F		16 - 2 - 3 - 4 - 5 - 6
48						AE27-010/2021 M	AE27-015/2020 M	AE27-021/2020 F		16 - 5 -11
49						AE27-019/2022 M	MN96-005/2021 M	AE27-068/2021 F		16 - 9 14
50
Croissement

 

[Peter_SSs]

Give this a try with a copy of your data.

Sub SubjectGroups()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim i As Long
  Dim CurrGroup As String
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("A2", Range("F" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If Len(a(i, 1)) > 0 Then CurrGroup = a(i, 1)
    If Len(a(i, 6)) > 0 Then d(a(i, 6)) = d(a(i, 6)) & " - " & CurrGroup
  Next i
  For i = 1 To UBound(a)
    If Len(a(i, 6)) > 0 Then b(i, 1) = Mid(d(a(i, 6)), 4)
  Next i
  With Range("J2").Resize(UBound(b))
    .NumberFormat = "@"
    .Value = b
  End With
End Sub

 

[harzer]

Hello Peter_SSs,
Thanks for your feedback.
Just one word, you are ingenious, your code meets my expectations, gives me the desired result and completely satisfies me, plus it is very fast. Well done again.
Friendships.

 

[Peter_SSs]

You are welcome. Thanks for the follow-up. .. and your kind words.

 

[harzer]

Hello Peter_SSs,
I tested your code, on with groups of 4 lines and more, the code works well too, thank you.
Can you please write a macro that could color the groups with different colors (preferably light colors, that way I can distinguish the groups more easily.
Do not modify the existing code which indicates the groups but create a new macro which colors the various groups.
Thanks in advance

 

[Peter_SSs]

Try this as a start. I have assumed less than about 50 groups. If more a different approach would be needed.

Sub Colour_Groups()
  Dim r As Long, ClrIdx As Long
  
  Application.ScreenUpdating = False
  ClrIdx = 2
  For r = 2 To Range("F" & Rows.Count).End(xlUp).Row
    If Len(Range("A" & r).Value) > 0 Then ClrIdx = ClrIdx + 1
    Rows(r).Resize(, 8).Interior.ColorIndex = ClrIdx
  Next r
  Application.ScreenUpdating = True
End Sub

(preferably light colors, ..

If you don't like the colours from the above code, perhaps we could choose a few different light colours (example say five of them) and cycle through those colours so they might get used several times (but not next to each other). Does that sound acceptable?

 

[harzer]

Hello Peter_SSs,
Thank you for your feedback, the code proposed is PERFECT, it suits me completely.
Here, it's 2:00 a.m., I'm going to bed and wishing you a good day, if it's daytime where you live, or a good night if you're in the evening.
Friendships.

 

[Peter_SSs]

You're welcome. Glad it worked for you. Thanks for the confirmation.