How sort duplicates data under each other of them for each duplicates dates

[abdo meghari]

Hello ,

I search for macro to deal with about 8000 rows to sort duplicates data based on ref , date columns(E,H).

should sort data by put duplicates ref under each other of them for each date and arrange based on orders for each ref is written first to last for each date.

orders
	E	F	G	H	I	J	K
1	DATE	BRAND	INV NO	REF	ENTER	OUT	NET
2	01/11/2024	BS 1200R20 G580 JAP	BSJ2000-1	NBFDG MG	2,000.00	200.00	1,800.00
3	01/11/2024	BS 1200R20 G580 THI	BSJ2000-1	VBF MHJY6	3,000.00	100.00	2,900.00
4	01/11/2024	BS 1200R24 G580 THI	BSJ2000-1	TR200 MNB6	2,200.00	120.00	2,080.00
5	01/11/2024	BS 1200R24 G580 JAP	BSJ2000-1	TT4000	12,000.00	130.00	11,870.00
6	01/11/2024	BS 1200R24 G550 JAP	BSJ2000-1	TT4001	12,000.00	140.00	11,860.00
7	01/11/2024	BS 1200R20 G580 JAP	BSJ2000-2	NBFDG MG	1,200.00	200.00	1,000.00
8	01/11/2024	BS 1200R20 G580 THI	BSJ2000-2	VBF MHJY6	1,300.00	120.00	1,180.00
9	01/11/2024	BS 1200R20 G580 THI	BSJ2000-3	VBF MHJY6	1,700.00	80.00	1,620.00
10	01/11/2024	BS 1200R24 G580 JAP	BSJ2000-3	TT4000	1,800.00	90.00	1,710.00
11	01/11/2024	BS 1200R20 G580 JAP	BSJ2000-3	NBFDG MG	1,900.00	60.00	1,840.00
12	02/11/2024	BS 1200R20 G580 THI	BSJ2000-4	VBF MHJY6	2,000.00	34.00	1,966.00
13	02/11/2024	BS 1200R24 G580 JAP	BSJ2000-4	TT4000	3,000.00	78.00	2,922.00
14	02/11/2024	BS 1200R24 G580 THI	BSJ2000-4	TR200 MNB6	1,200.00	123.00	1,077.00
15	02/11/2024	BS 1200R20 G580 JAP	BSJ2000-4	NBFDG MG	4,000.00	24.00	3,976.00
16	02/11/2024	BS 1200R24 G580 THI	BSJ2000-5	TR200 MNB6	2,300.00	67.00	2,233.00
17	02/11/2024	BS 1200R20 G580 JAP	BSJ2000-5	NBFDG MG	1,200.00	987.00	213.00
18	02/11/2024	BS 1200R24 G580 JAP	BSJ2000-5	TT4000	1,400.00	124.00	1,276.00
19	TOTAL				54,200.00	2,677.00	51,523.00
ENTER

Cell Formulas
Range	Formula
I19:J19	I19	=SUM(I2:I18)
K19	K19	=I19-J19

should sort like this

orders
	E	F	G	H	I	J	K
1	DATE	BRAND	INV NO	REF	QTY	OUT	NET
2	01/11/2024	BS 1200R20 G580 JAP	BSJ2000-1	NBFDG MG	2,000.00	200.00	1,800.00
3	01/11/2024	BS 1200R20 G580 JAP	BSJ2000-2	NBFDG MG	1,200.00	200.00	1,000.00
4	01/11/2024	BS 1200R20 G580 JAP	BSJ2000-3	NBFDG MG	1,900.00	60.00	1,840.00
5	01/11/2024	BS 1200R20 G580 THI	BSJ2000-1	VBF MHJY6	3,000.00	100.00	2,900.00
6	01/11/2024	BS 1200R20 G580 THI	BSJ2000-2	VBF MHJY6	1,300.00	120.00	1,180.00
7	01/11/2024	BS 1200R20 G580 THI	BSJ2000-3	VBF MHJY6	1,700.00	80.00	1,620.00
8	01/11/2024	BS 1200R24 G580 THI	BSJ2000-1	TR200 MNB6	2,200.00	120.00	2,080.00
9	01/11/2024	BS 1200R24 G580 JAP	BSJ2000-1	TT4000	12,000.00	130.00	11,870.00
10	01/11/2024	BS 1200R24 G580 JAP	BSJ2000-3	TT4000	1,800.00	90.00	1,710.00
11	01/11/2024	BS 1200R24 G550 JAP	BSJ2000-1	TT4001	12,000.00	140.00	11,860.00
12	02/11/2024	BS 1200R20 G580 THI	BSJ2000-4	VBF MHJY6	2,000.00	34.00	1,966.00
13	02/11/2024	BS 1200R24 G580 JAP	BSJ2000-4	TT4000	3,000.00	78.00	2,922.00
14	02/11/2024	BS 1200R24 G580 JAP	BSJ2000-5	TT4000	1,400.00	124.00	1,276.00
15	02/11/2024	BS 1200R24 G580 THI	BSJ2000-4	TR200 MNB6	1,200.00	123.00	1,077.00
16	02/11/2024	BS 1200R24 G580 THI	BSJ2000-5	TR200 MNB6	2,300.00	67.00	2,233.00
17	02/11/2024	BS 1200R20 G580 JAP	BSJ2000-4	NBFDG MG	4,000.00	24.00	3,976.00
18	02/11/2024	BS 1200R20 G580 JAP	BSJ2000-5	NBFDG MG	1,200.00	987.00	213.00
19	TOTAL				54,200.00	2,677.00	51,523.00
ENTER

Cell Formulas
Range	Formula
I19:J19	I19	=SUM(I2:I18)
K19	K19	=I19-J19

note: orders will be different in sorting for each date based on who ref start writing.

 

[Peter_SSs]

Seems to be almost identical to the question asked today by your colleague here. Try modifying the suggestions there.

 

[abdo meghari]

Hi ,
I prefer your code because of it's short.
well, I try to modify to implement in the same sheet and should also show formula in last column for last row by subtract column I from column J , I don't need the formulas in NET column for each cell.
the code will show compile error in this word .Resize in this line

Range("I1:N1").Resize (UBound(a))

here is modification .

Sub Rearrange()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  Dim s As String
 
  Set d = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  a = Range("E1", Range("K" & Rows.Count).End(xlUp)).Value
  For i = 2 To UBound(a)
    s = a(i, 1) & "|" & a(i, 4)
    If Not d.exists(s) Then d(s) = d.Count + 1
    a(i, 7) = d(s)
  Next i
    Range("E1:K1").Resize (UBound(a))

    .EntireColumn.ClearContents
    .Value = a
    .Sort Key1:=.Columns(7), Order1:=xlAscending, Header:=xlYes
    '.Columns(6).Offset(1).Resize(UBound(a) - 1).FormulaR1C1 = "=RC[-2]-RC[-1]+N(R[-1]C)*(RC[-5]=R[-1]C[-5])*(RC[-3]=R[-1]C[-3])"
    .Cells(UBound(a), 4).Resize(, 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
  End With
  Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

I try to modify to implement in the same sheet

Glad you tried.

Your effort was not too bad and there are usually multiple ways to get a particular result.
The problem with the Error line you had is that it needed a "With" in front of it. However I have removed that whole line in my suggestion below.
Anyway, this is how I would do what I think you are after. Test with a copy.

Sub Rearrange()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  Dim s As String
 
  Set d = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  With Range("E1", Range("K" & Rows.Count).End(xlUp))
    a = .Value
    For i = 2 To UBound(a)
      s = a(i, 1) & "|" & a(i, 4)
      If Not d.exists(s) Then d(s) = d.Count + 1
      a(i, 7) = d(s)
    Next i
    .Value = a
    .Sort Key1:=.Columns(7), Order1:=xlAscending, Header:=xlYes
    .Columns(7).Offset(1).Resize(UBound(a) - 1).FormulaR1C1 = "=RC[-2]-RC[-1]"
    .Columns(7).Resize(UBound(a) - 1).Value = .Columns(7).Resize(UBound(a) - 1).Value
    .Cells(UBound(a), 5).Resize(, 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
  End With
  Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

Excellent !
many thanks for this help.

 

[Peter_SSs]

You are welcome. Thanks for the follow-up.