Add headers for each range within a table from the first row to the last row of the same repeating element

[leap out]

Hi

I want to add headers for each separate range and for each element, starting from the first row and ending with the last row for the same element, provided that the entire range is duplicated for the same element based on column A, and the headers must be the same as in the first row for all ranges, as in the second range, the headers are different For the headers of the first row of the first range, then the headers of the first row of the first range must be replaced with the headers of the second .as to third range should insert new row before the first row with a new element and after the last row of the element that precedes it, and the headings are the same as the headers of the first row for the first range
will be add new ranges , so the macro must be applied several times each time new ranges are added without affecting what was previously executed on some of the ranges that already existed.


before

items v .xlsm
	A	B	C	D	E	F	G	H
1	CLASSIFICATION	GOODS	MARK	MANFACTURE	BUYING	SELLING	NET	NOTE
2	OIL-AS2	MLO-1 10W40 208L TT/L	CAS	SU	23
3	OIL-AS2	10W40 208L	ENI	IT	12	11
4	OIL-AS2	5W30 208L	Q8	EU
5	OIL-AS2	10W40 208L	Q8	EU	11
6	ITEM	BRAND	SQ	PRTD4	ENTER	OUT	TOTAL	DEL.SS
7	OIL-AS3	10W40 12x1L	Q8	EU	111
8	OIL-AS3	10W40 12x1L	CAS	SU	111
9	OIL-AS3	10W40 12x1L	ENI	IT	112
10	OIL-AS3	OL-115W40 12x1L	CAS	SU**2	22
11	MS-OIL1	5W30 12x1L	Q8	EU	11
12	MS-OIL1	10W40 4x4L	Q8	EU	111		11
13	MS-OIL1	OIL/M 10W40 4x4L	CAS TRM	SU N3-90	33
14	MS-OIL1	10W40 4x4L MNH/80-T	ENI	IT L66RT	44
15	MS-OIL1	5W40 4x4L	Q8	EU	555
16	MS-OIL1	5W40 4x4L	CAS	SU	555
17	MS-OIL1	5W40 4x4L	ENI	IT	555
18	MS-OIL1	20W50 4x4L	Q8	EU	222
19	MS-OIL1	20W50 4x4L	CAS	SU	222
20	MS-OIL1	20W50 4x4L	ENI	IT	222
21	MS-OIL1	5W30 4x4L	Q8	EU	555
5

after

items v .xlsm
	A	B	C	D	E	F	G	H
1	CLASSIFICATION	GOODS	MARK	MANFACTURE	BUYING	SELLING	NET	NOTE
2	OIL-AS2	MLO-1 10W40 208L TT/L	CAS	SU	23
3	OIL-AS2	10W40 208L	ENI	IT	12	11
4	OIL-AS2	5W30 208L	Q8	EU
5	OIL-AS2	10W40 208L	Q8	EU	11
6	CLASSIFICATION	GOODS	MARK	MANFACTURE	BUYING	SELLING	NET	NOTE
7	OIL-AS3	10W40 12x1L	Q8	EU	111
8	OIL-AS3	10W40 12x1L	CAS	SU	111
9	OIL-AS3	10W40 12x1L	ENI	IT	112
10	OIL-AS3	OL-115W40 12x1L	CAS	SU**2	22
11	CLASSIFICATION	GOODS	MARK	MANFACTURE	BUYING	SELLING	NET	NOTE
12	MS-OIL1	5W30 12x1L	Q8	EU	11
13	MS-OIL1	10W40 4x4L	Q8	EU	111		11
14	MS-OIL1	OIL/M 10W40 4x4L	CAS TRM	SU N3-90	33
15	MS-OIL1	10W40 4x4L MNH/80-T	ENI	IT L66RT	44
16	MS-OIL1	5W40 4x4L	Q8	EU	555
17	MS-OIL1	5W40 4x4L	CAS	SU	555
18	MS-OIL1	5W40 4x4L	ENI	IT	555
19	MS-OIL1	20W50 4x4L	Q8	EU	222
20	MS-OIL1	20W50 4x4L	CAS	SU	222
21	MS-OIL1	20W50 4x4L	ENI	IT	222
22	MS-OIL1	5W30 4x4L	Q8	EU	555
5

 

[Legacy 143009]

Hi!

This should work for you:

Sub test()
  Dim lRow As Long, i As Long
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  With ActiveSheet
    .AutoFilterMode = False
    With Range("A1:A" & lRow)
        .AutoFilter 1, "ITEM"
        On Error Resume Next
        .Offset(1).EntireRow.Delete
    End With
    .AutoFilterMode = False
  On Error GoTo 0
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  Application.ScreenUpdating = False
  For i = lRow To 3 Step -1
    If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
      Rows(1).Copy
      Rows(i).EntireRow.Insert
    End If
  Next
  Application.ScreenUpdating = True
  End With
End Sub

 

[leap out]

thanks
gives error Autofilter method of range class failed in this line

        .AutoFilter 1, "ITEM"

​

 

[Legacy 143009]

See this file is working. I am not sharing the code because it is exactly the same as post#2.

Sample.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[leap out]

strange!
I should check again what's the problem
ok but there is problem after run the macro and add new data should not add headers again for data have already added.

 

[Legacy 143009]

Then change this line:

If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then

to this:

If Cells(i, 1).Value <> Cells(i - 1, 1).Value And Cells(i - 1, 1).Value <> "CLASSIFICATION" Then

 

[leap out]

thanks again

I should check again what's the problem

now I see the problem . you use normal range but I use Table .
do you have any idea how do that with Table?

 

[Legacy 143009]

How about like this? It converts the table to dynamic range then converts back to table again:

Sub test()
  Dim lRow As Long, i As Long
  Dim rList As Range
 
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  With ActiveSheet
  Set rList = .ListObjects("Table1").Range 'your table name
  .ListObjects(1).Unlist 'convert to range
  .AutoFilterMode = False
  With Range("A1:A" & lRow)
  .AutoFilter 1, "ITEM"
  On Error Resume Next
  .Offset(1).EntireRow.Delete
  End With
  .AutoFilterMode = False
  On Error GoTo 0
  lRow = Cells(Rows.Count, 1).End(xlUp).Row
  Application.ScreenUpdating = False
  For i = lRow To 3 Step -1
    If Cells(i, 1).Value <> Cells(i - 1, 1).Value And Cells(i - 1, 1).Value <> "CLASSIFICATION" Then
      Rows(1).Copy
      Rows(i).EntireRow.Insert
    End If
  Next
  Application.ScreenUpdating = True
  .ListObjects.Add(xlSrcRange, Range([A1].End(xlDown), [A1].End(xlToRight)), , xlYes).Name = "Table1" 'convert back to table
  End With
End Sub

 

[leap out]

perfect !
can you fix as you did it in post#6 ?
because it will repeat copy the headers , despite of the same line is existed in the code as you did it in post#6

 

[Legacy 143009]

No, it shouldn't do that.