Grouping of lines having the same value in columns "B" and "C" with respect to the following line.

harzer · Jan 19, 2023

Hello, As I am not a vba expert, I am posting my request hoping that an expert will help me find a solution to my problem. In the "B_D" sheet, I have a table of ten columns and many (many) rows whose length varies each year, I would like to group all the rows whose contents of the cell of the 2nd column and that of the cell of the 3rd column are identical with the cells of the following line to the same columns. I prefer (if possible) the use of dictionary(s) given their efficiency in the processing of important data. I add that it would also be desirable (for more visibility) to insert an empty line between each group of data. Sample Data from sheet "B_D"

Desired results, see sheet "Result"

I remain at your disposal for any additional information.
Cheers.

kevin9999 · Jan 20, 2023

It's very difficult when you don't provide a sample of your data using the XL2BB add in, as very few people would be prepared to copy data from an image. The following code makes the following assumptions:
1. Row 1 is a header row, and your data starts in row 2
2. In your image, "Jeunes" is in cell A1
3. Your data is contiguous

Not sure why you wanted to use a dictionary method (which is more suited to unique values) but see how you go with this.

VBA Code:

Sub harzer1()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("B_D")
    
    'Sort the data by columns B & C
    With ws.Range("A1").CurrentRegion
        .Sort Key1:=ws.Range("B1"), order1:=xlAscending, _
        Key2:=ws.Range("C1"), order2:=xlAscending, Header:=xlYes
    End With
    
    'Determine where groups end
    Dim LRow As Long, LCol As Long, i As Long
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    
    Dim ArrIn, ArrOut
    ArrIn = ws.Range(ws.Cells(2, 2), ws.Cells(LRow, 3))
    ReDim ArrOut(1 To UBound(ArrIn), 1 To 1)
    
    For i = 2 To UBound(ArrIn)
        If ArrIn(i, 1) <> ArrIn(i - 1, 1) Or ArrIn(i, 2) <> ArrIn(i - 1, 2) Then ArrOut(i, 1) = 1
    Next i
    ws.Cells(2, LCol).Resize(UBound(ArrIn)) = ArrOut
    
    'Insert the gaps between groups
    Dim r As Range
    Set r = ws.Columns(LCol).SpecialCells(xlCellTypeConstants)
    r.EntireRow.Insert shift:=xlDown
    ws.Columns(LCol).ClearContents
    
    Application.ScreenUpdating = True
End Sub

harzer · Jan 20, 2023

Hello,
Thank you for your reply. As you indicated :
1. Line 1 is a header line. = Yes
2. My data starts at line 2. = Yes
3. The "young people" cell is in A1. = Yes
4. My data is contiguous. = Yes
I have done some tests but the results are not correct, the grouped groups are not correct and sometimes I have several blank lines instead of one to separate the groups.
That's why I'll try to send you the data by XL2BB hoping it will work, so you can test yourself.
So here's the data!
Cordially.

Harzer_v02.xls

A

B

C

D

E

F

G

H

I

J

1

JEUNE

PÈRE

MÈRE

Eleveur

Age

Volière

Cage

Né(e)

Tours

Information

2

0811-109/2008 M

0811-006/2007 M

0811-098/2007 F

1

2

3

4

5

6

Pas d'infos

3

0811-021/2008 M

0811-007/2007 M

0811-047/2006 F

1

2

3

4

5

6

Pas d'infos

4

0811-015/2008 F

0811-009/2007 M

0811-075/2006 F

1

2

3

4

5

6

Pas d'infos

5

HTY03-062/2010 M

0811-009/2007 M

0811-075/2006 F

1

2

3

4

5

6

Pas d'infos

6

0811-006/2010 M

0811-016/2009 M

0811-133/2008 F

1

2

3

4

5

6

Pas d'infos

7

GUS14-051/2010 F

0811-021/2008 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

8

GUS14-025/2010 F

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

9

GUS14-039/2010 M

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

10

GUS14-041/2010 F

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

11

0811-076/2006 M

0811-055/2005 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

12

0811-012/2009 M

0811-055/2005 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

13

0811-153/2009 M

0811-076/2006 M

0811-018/2008 F

1

2

3

4

5

6

Pas d'infos

14

0811-133/2008 F

0811-076/2006 M

0811-048/2007 F

1

2

3

4

5

6

Pas d'infos

15

0811-016/2009 M

0811-076/2006 M

0811-153/2007 F

1

2

3

4

5

6

Pas d'infos

16

ABD27-054/2010 F

0811-104/2009 M

ABD27-002/2009 F

1

2

3

4

5

6

Pas d'infos

17

ABD27-101/2009 M

0811-104/2009 M

ABD27-002/2009 F

1

2

3

4

5

6

Pas d'infos

18

ABD27-046/2010 F

0811-109/2008 M

0811-015/2008 F

1

2

3

4

5

6

Pas d'infos

19

ABD27-002/2009 F

0811-109/2008 M

0811-038/2008 F

1

2

3

4

5

6

Pas d'infos

20

ABD27-088/2008 M

0811-134/2007 M

0811-094/2005 F

1

2

3

4

5

6

Pas d'infos

21

0811-041/2011 M

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

22

ABD27-048/2010 M

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

23

ABD27-012/2014 F

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

24

ABD27-013/2014 M

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

25

ABD27-014/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

26

ABD27-015/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

27

ABD27-016/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

28

ABD27-048/2014 M

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

29

ABD27-049/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

30

ABD27-050/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

31

ABD27-051/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

32

ABD27-020/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

33

ABD27-021/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

34

ABD27-022/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

B_D

harzer · Jan 20, 2023

Unless I'm mistaken, here are the desired results.

Harzer_v02.xls

A

B

C

D

E

F

G

H

I

J

1

JEUNE

PÈRE

MÈRE

Eleveur

Age

Volière

Cage

Né(e)

Tours

Information

2

0811-109/2008 M

0811-006/2007 M

0811-098/2007 F

1

2

3

4

5

6

Pas d'infos

3

4

0811-021/2008 M

0811-007/2007 M

0811-047/2006 F

1

2

3

4

5

6

Pas d'infos

5

6

0811-015/2008 F

0811-009/2007 M

0811-075/2006 F

1

2

3

4

5

6

Pas d'infos

7

HTY03-062/2010 M

0811-009/2007 M

0811-075/2006 F

1

2

3

4

5

6

Pas d'infos

8

9

0811-006/2010 M

0811-016/2009 M

0811-133/2008 F

1

2

3

4

5

6

Pas d'infos

10

11

GUS14-051/2010 F

0811-021/2008 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

12

13

GUS14-025/2010 F

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

14

GUS14-039/2010 M

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

15

GUS14-041/2010 F

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

16

17

0811-076/2006 M

0811-055/2005 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

18

0811-012/2009 M

0811-055/2005 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

19

20

0811-153/2009 M

0811-076/2006 M

0811-018/2008 F

1

2

3

4

5

6

Pas d'infos

21

22

0811-133/2008 F

0811-076/2006 M

0811-048/2007 F

1

2

3

4

5

6

Pas d'infos

23

24

0811-016/2009 M

0811-076/2006 M

0811-153/2007 F

1

2

3

4

5

6

Pas d'infos

25

26

ABD27-054/2010 F

0811-104/2009 M

ABD27-002/2009 F

1

2

3

4

5

6

Pas d'infos

27

ABD27-101/2009 M

0811-104/2009 M

ABD27-002/2009 F

1

2

3

4

5

6

Pas d'infos

28

29

ABD27-046/2010 F

0811-109/2008 M

0811-015/2008 F

1

2

3

4

5

6

Pas d'infos

30

31

ABD27-002/2009 F

0811-109/2008 M

0811-038/2008 F

1

2

3

4

5

6

Pas d'infos

32

33

ABD27-088/2008 M

0811-134/2007 M

0811-094/2005 F

1

2

3

4

5

6

Pas d'infos

34

35

0811-041/2011 M

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

36

ABD27-048/2010 M

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

37

ABD27-012/2014 F

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

38

39

ABD27-013/2014 M

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

40

ABD27-014/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

41

ABD27-015/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

42

ABD27-016/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

43

44

ABD27-048/2014 M

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

45

ABD27-049/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

46

ABD27-050/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

47

ABD27-051/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

48

49

ABD27-020/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

50

ABD27-021/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

51

ABD27-022/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

B_D

kevin9999 · Jan 20, 2023

Thank you for providing the XL2BB sample - it makes life much easier

Please try the adjusted code below, the result of which is at bottom.

VBA Code:

Option Explicit
Sub harzer2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("B_D")
    
    'Sort the data by columns B & C
    With ws.Range("A1").CurrentRegion
        .Sort Key1:=ws.Range("B1"), order1:=xlAscending, _
        Key2:=ws.Range("C1"), order2:=xlAscending, Header:=xlYes
    End With
    
    'Determine where groups end & insert gaps
    Dim LRow As Long, i As Long
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    
    For i = LRow To 3 Step -1
        If ws.Cells(i, 2) <> ws.Cells(i - 1, 2) Or ws.Cells(i, 3) <> ws.Cells(i - 1, 3) Then
            ws.Rows(i).EntireRow.Insert shift:=xlDown
        End If
    Next i
        
    Application.ScreenUpdating = True
End Sub

harzer.xlsm

A

B

C

D

E

F

G

H

I

J

1

JEUNE

PÈRE

MÈRE

Eleveur

Age

Volière

Cage

Né(e)

Tours

Information

2

0811-109/2008 M

0811-006/2007 M

0811-098/2007 F

1

2

3

4

5

6

Pas d'infos

3

4

0811-021/2008 M

0811-007/2007 M

0811-047/2006 F

1

2

3

4

5

6

Pas d'infos

5

6

0811-015/2008 F

0811-009/2007 M

0811-075/2006 F

1

2

3

4

5

6

Pas d'infos

7

HTY03-062/2010 M

0811-009/2007 M

0811-075/2006 F

1

2

3

4

5

6

Pas d'infos

8

9

0811-006/2010 M

0811-016/2009 M

0811-133/2008 F

1

2

3

4

5

6

Pas d'infos

10

11

GUS14-051/2010 F

0811-021/2008 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

12

13

GUS14-025/2010 F

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

14

GUS14-039/2010 M

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

15

GUS14-041/2010 F

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

16

17

0811-076/2006 M

0811-055/2005 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

18

0811-012/2009 M

0811-055/2005 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

19

20

0811-153/2009 M

0811-076/2006 M

0811-018/2008 F

1

2

3

4

5

6

Pas d'infos

21

22

0811-133/2008 F

0811-076/2006 M

0811-048/2007 F

1

2

3

4

5

6

Pas d'infos

23

24

0811-016/2009 M

0811-076/2006 M

0811-153/2007 F

1

2

3

4

5

6

Pas d'infos

25

26

ABD27-054/2010 F

0811-104/2009 M

ABD27-002/2009 F

1

2

3

4

5

6

Pas d'infos

27

ABD27-101/2009 M

0811-104/2009 M

ABD27-002/2009 F

1

2

3

4

5

6

Pas d'infos

28

29

ABD27-046/2010 F

0811-109/2008 M

0811-015/2008 F

1

2

3

4

5

6

Pas d'infos

30

31

ABD27-002/2009 F

0811-109/2008 M

0811-038/2008 F

1

2

3

4

5

6

Pas d'infos

32

33

ABD27-088/2008 M

0811-134/2007 M

0811-094/2005 F

1

2

3

4

5

6

Pas d'infos

34

35

0811-041/2011 M

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

36

ABD27-048/2010 M

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

37

ABD27-012/2014 F

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

38

39

ABD27-013/2014 M

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

40

ABD27-014/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

41

ABD27-015/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

42

ABD27-016/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

43

44

ABD27-048/2014 M

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

45

ABD27-049/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

46

ABD27-050/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

47

ABD27-051/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

48

49

ABD27-020/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

50

ABD27-021/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

51

ABD27-022/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

B_D

harzer · Jan 20, 2023

Thank you for your reply.
What a pleasure and respect to you for sharing your knowledge and especially for your availability.
I tested your proposal, it gives the right result and meets my expectations.
As this problem is solved, I allow myself to ask you for a proposal in the same order, but this time it is for:

• Via a 2nd button, group all the lines whose content of the cell of the 2nd column is identical with the cells of the following lines in the same column, so we are only working on a single column "B", do not forget S-V-P the dividing line between groups.

• Via a 3rd button, group all the lines whose content of the cell of the 3rd column is identical with the cells of the following lines in the same column, so we are only working on a single column "C", do not forget S-V-P the dividing line between groups.

Thank you in advance for your future proposal.

Unless I'm mistaken, this is the desired result:

Harzer_v02.xls

A

B

C

D

E

F

G

H

I

J

1

JEUNE

PÈRE

MÈRE

Eleveur

Age

Volière

Cage

Né(e)

Tours

Information

2

0811-109/2008 M

0811-006/2007 M

0811-098/2007 F

1

2

3

4

5

6

Pas d'infos

3

4

0811-021/2008 M

0811-007/2007 M

0811-047/2006 F

1

2

3

4

5

6

Pas d'infos

5

6

0811-015/2008 F

0811-009/2007 M

0811-075/2006 F

1

2

3

4

5

6

Pas d'infos

7

HTY03-062/2010 M

0811-009/2007 M

0811-075/2006 F

1

2

3

4

5

6

Pas d'infos

8

9

0811-006/2010 M

0811-016/2009 M

0811-133/2008 F

1

2

3

4

5

6

Pas d'infos

10

11

GUS14-051/2010 F

0811-021/2008 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

12

GUS14-025/2010 F

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

13

GUS14-039/2010 M

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

14

GUS14-041/2010 F

0811-021/2008 M

GUS14-017/2009 F

1

2

3

4

5

6

Pas d'infos

15

16

0811-076/2006 M

0811-055/2005 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

17

0811-012/2009 M

0811-055/2005 M

0811-044/2005 F

1

2

3

4

5

6

Pas d'infos

18

19

0811-153/2009 M

0811-076/2006 M

0811-018/2008 F

1

2

3

4

5

6

Pas d'infos

20

0811-133/2008 F

0811-076/2006 M

0811-048/2007 F

1

2

3

4

5

6

Pas d'infos

21

0811-016/2009 M

0811-076/2006 M

0811-153/2007 F

1

2

3

4

5

6

Pas d'infos

22

23

ABD27-054/2010 F

0811-104/2009 M

ABD27-002/2009 F

1

2

3

4

5

6

Pas d'infos

24

ABD27-101/2009 M

0811-104/2009 M

ABD27-002/2009 F

1

2

3

4

5

6

Pas d'infos

25

26

ABD27-046/2010 F

0811-109/2008 M

0811-015/2008 F

1

2

3

4

5

6

Pas d'infos

27

ABD27-002/2009 F

0811-109/2008 M

0811-038/2008 F

1

2

3

4

5

6

Pas d'infos

28

29

ABD27-088/2008 M

0811-134/2007 M

0811-094/2005 F

1

2

3

4

5

6

Pas d'infos

30

31

0811-041/2011 M

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

32

ABD27-048/2010 M

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

33

ABD27-012/2014 F

0811-153/2009 M

0811-006/2010 F

1

2

3

4

5

6

Pas d'infos

34

35

ABD27-013/2014 M

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

36

ABD27-014/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

37

ABD27-015/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

38

ABD27-016/2014 F

1183-028/2012 M

GUS14-031/2012 F

1

2

3

4

5

6

Pas d'infos

39

40

ABD27-048/2014 M

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

41

ABD27-049/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

42

ABD27-050/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

43

ABD27-051/2014 F

1183-036/2012 M

GUS14-118/2012 F

1

2

3

4

5

6

Pas d'infos

44

45

ABD27-020/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

46

ABD27-021/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

47

ABD27-022/2014 M

1183-037/2012 M

GUS14-020/2012 F

1

2

3

4

5

6

Pas d'infos

B_D

kevin9999 · Jan 20, 2023

Relatively straightforward, but I'll be unavailable for a few hours although I will get to this today.

kevin9999 · Jan 20, 2023

OK, in essence you're looking for 3 separate subs. The 3 below cover your requirements for columns B & C, column B only, and column C only. Their names tell you which ones they are.

VBA Code:

Sub Group_Both_B_and_C()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("B_D")
    
    'Sort the data by columns B & C
    With ws.UsedRange
        .Sort Key1:=ws.Range("B1"), order1:=xlAscending, _
        Key2:=ws.Range("C1"), order2:=xlAscending, Header:=xlYes
    End With
    
    'Determine where groups end & insert gaps
    Dim LRow As Long, i As Long
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    
    For i = LRow To 3 Step -1
        If ws.Cells(i, 2) <> ws.Cells(i - 1, 2) Or ws.Cells(i, 3) <> ws.Cells(i - 1, 3) Then
            ws.Rows(i).EntireRow.Insert shift:=xlDown
        End If
    Next i
        
    Application.ScreenUpdating = True
End Sub

VBA Code:

Sub Group_By_B()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("B_D")
    
    'Sort the data by columns B & C
    With ws.UsedRange
        .Sort Key1:=ws.Range("B1"), order1:=xlAscending, _
        Key2:=ws.Range("C1"), order2:=xlAscending, Header:=xlYes
    End With
    
    'Determine where groups end & insert gaps
    Dim LRow As Long, i As Long
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    
    For i = LRow To 3 Step -1
        If ws.Cells(i, 2) <> ws.Cells(i - 1, 2) Then
            ws.Rows(i).EntireRow.Insert shift:=xlDown
        End If
    Next i
        
    Application.ScreenUpdating = True
End Sub

VBA Code:

Sub Group_By_C()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("B_D")
    
    'Sort the data by columns B & C
    With ws.UsedRange
        .Sort Key1:=ws.Range("B1"), order1:=xlAscending, _
        Key2:=ws.Range("C1"), order2:=xlAscending, Header:=xlYes
    End With
    
    'Determine where groups end & insert gaps
    Dim LRow As Long, i As Long
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    
    For i = LRow To 3 Step -1
        If ws.Cells(i, 3) <> ws.Cells(i - 1, 3) Then
            ws.Rows(i).EntireRow.Insert shift:=xlDown
        End If
    Next i
        
    Application.ScreenUpdating = True
End Sub

harzer · Jan 21, 2023

Hello Kevin9999, Thank you for your proposals which give me total satisfaction.
Sincerely.

kevin9999 · Jan 21, 2023

harzer said:
Hello Kevin9999, Thank you for your proposals which give me total satisfaction.
Sincerely.

Happy to help, and thanks for the feedback

Grouping of lines having the same value in columns "B" and "C" with respect to the following line.

harzer

Board Regular

Excel Facts

kevin9999

Well-known Member

harzer

Board Regular

harzer

Board Regular

kevin9999

Well-known Member

harzer

Board Regular

kevin9999

Well-known Member

kevin9999

Well-known Member

harzer

Board Regular

kevin9999

Well-known Member

Similar threads

Forum statistics

Share this page

Grouping of lines having the same value in columns "B" and "C" with respect to the following line.

Board Regular

Excel Facts

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Well-known Member

Well-known Member

Board Regular

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