split data to multiple sheets based on month and summing the values

[MKLAQ]

hello
I have data in sheet ENTER what I want creating multiple sheets for JAN up o DEC it should copy data from sheet ENTER to sheet relating the month based on COL A in sheet ENTER for instance any data are in JAN month then should copy to sheet JAN and so on the rest of sheets and if I change the data in sheet ENTER then should update the relating sheet months and show the total
sheet ENTER

REPORT (2).xlsx
	A	B	C	D	E
1	DATE	BRAND	TYPE	MODEL	QTY
2	1/1/2021	CC-SS	BMW	2010	250
3	1/2/2021	CC-SS	BMW	2011	125
4	1/3/2021	CC-SS	BMW	2013	66
5	1/4/2021	CC-MM	MER	2020	55
6	2/5/2021	CC-MM	MER	2021	88
7	2/6/2021	CC-MM	MER	2017	99
8	2/7/2021	CC-LL	AUDI	2011	14
9	2/8/2021	CC-LL	AUDI	2015	12
10	3/9/2021	CC-LL	AUDI	2016	15
ENTER

desire result
sheet JAN

REPORT (2).xlsx
	A	B	C	D	E
1	DATE	BRAND	TYPE	MODEL	QTY
2	1/1/2021	CC-SS	BMW	2010	250
3	1/2/2021	CC-SS	BMW	2011	125
4	1/3/2021	CC-SS	BMW	2013	66
5	1/4/2021	CC-MM	MER	2020	55
6	LTT				496
JAN

sheet FEB

REPORT (2).xlsx
	B	C	D	E	F
2	2/5/2021	CC-MM	MER	2021	88
3	2/6/2021	CC-MM	MER	2017	99
4	2/7/2021	CC-LL	AUDI	2011	14
5	2/8/2021	CC-LL	AUDI	2015	12
6	LTT				213
FEB

sheet MAR

REPORT (2).xlsx
	A	B	C	D	E
1	DATE	BRAND	TYPE	MODEL	QTY
2	3/9/2021	CC-LL	AUDI	2016	15
3	LTT				15
MAR

 

[mumps]

This macro should create the monthly sheets.

Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, ldatefrom As Long, ldateto As Long, lMon As Long, x As Long, yr As Long, mName As String
    Set srcWS = Sheets("ENTER")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lMon = Month(WorksheetFunction.Max(srcWS.Range("A:A")))
    yr = Year(Range("A2"))
    For x = 1 To lMon
        mName = Left(MonthName(x), 3)
        ldatefrom = DateSerial(yr, x, 1)
        ldateto = DateSerial(yr, x + 1, 0)
        With srcWS.Range("A1").CurrentRegion
            .AutoFilter Field:=1, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            If Not Evaluate("isref('" & mName & "'!A1)") Then
               Sheets.Add(After:=Sheets(Sheets.Count)).Name = mName
               srcWS.AutoFilter.Range.Copy Range("A1")
               Cells(Rows.Count, "A").End(xlUp).Offset(1) = "LTT"
               Cells(Rows.Count, "E").End(xlUp).Offset(1).Formula = WorksheetFunction.Sum(Range("E2", Range("E" & Rows.Count).End(xlUp)))
            End If
        End With
    Next x
    srcWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

If you want to update the monthly sheets each time you change the data in sheet ENTER, then each row in sheet ENTER will need a unique identifier. The date in column A could be used as the unique identifier as long as there are no duplicate dates in column A. Can column A contain duplicate dates? If it can, then you will need to add another column with a unique identifier for each row. It can be as simple as consecutive numbers as shown below or you can use any value you want as long as there are no duplicates in column A. Would this work for you?

Book1
	A	B	C	D	E	F
1	ID	DATE	BRAND	TYPE	MODEL	QTY
2	1	1/1/2021	CC-SS	BMW	2010	250
3	2	1/2/2021	CC-SS	BMW	2011	125
4	3	1/3/2021	CC-SS	BMW	2013	66
5	4	1/4/2021	CC-MM	MER	2020	55
6	5	2/5/2021	CC-MM	MER	2021	88
7	6	2/6/2021	CC-MM	MER	2017	99
8	7	2/7/2021	CC-LL	AUDI	2011	14
9	8	2/8/2021	CC-LL	AUDI	2015	12
10	9	3/9/2021	CC-LL	AUDI	2016	15
ENTER

 

[MKLAQ]

thanks

Can column A contain duplicate dates?

yes , and I want the ID merges the values in COL C,D,E like this CC-SS -BMW- 2010
note: should highlight the LTT row as I did it

 

[mumps]

if I change the data in sheet ENTER

Can the data change in any column in sheet ENTER or can it change only in certain columns?

 

[MKLAQ]

Can the data change in any column in sheet ENTER?

yes

 

[mumps]

Can the date also change? If you change the month in any date, that creates a problem because the data on the row with the changed month will be on a different monthly sheet. How do you want to handle this possibility?

 

[MKLAQ]

I suppose if the change in day this is not problem , it keeps in the same month but if I change the month you right, it occurs a problem , in this case should delete from the previous month and updating in a new month

 

[mumps]

Can there be duplicate dates in any month? For example, the yellow cells in column B.

MKLAQ.xlsm
	A	B	C	D	E	F
1	ID	DATE	BRAND	TYPE	MODEL	QTY
2	CC-SS-BMW-2010	1/1/2021	CC-SS	BMW	2010	250
3	CC-SS-BMW-2011	1/1/2021	CC-SS	BMW	2011	125
4	CC-SS-BMW-2013	1/3/2021	CC-SS	BMW	2013	66
5	CC-MM-MER-2020	1/4/2021	CC-MM	MER	2020	55
6	CC-MM-MER-2021	2/5/2021	CC-MM	MER	2021	88
7	CC-MM-MER-2017	2/5/2021	CC-MM	MER	2017	99
8	CC-LL-AUDI-2011	2/7/2021	CC-LL	AUDI	2011	14
9	CC-LL-AUDI-2015	2/8/2021	CC-LL	AUDI	2015	12
10	CC-LL-AUDI-2016	3/9/2021	CC-LL	AUDI	2016	15
ENTER

 

[MKLAQ]

Can there be duplicate dates in any month? For example, the yellow cells in column B.

yes

 

[mumps]

Click here for your file. Give it a try and see how it works out. These macros are in the "ENTER" sheet code module.

Dim oldDate As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Select Case Target.Column
        Case Is = 2
            Range("AA1") = Target
        Case Is = 3, 4, 5, 6
            Range("AA1") = Range("A" & Target.Row)
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column = 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim ws As Worksheet, ID As Range
    Select Case Target.Column
        Case Is = 2
            If Month(Range("AA1")) = Month(Target) Then
                Set ws = Sheets(Left(MonthName(Month(Target)), 3))
                Set ID = ws.Range("A:A").Find(Target.Offset(, -1), LookIn:=xlValues, lookat:=xlWhole)
                If Not ID Is Nothing Then
                    Target.Offset(, -1).Resize(, 6).Copy ws.Range("A" & ID.Row)
                End If
            Else
                If Evaluate("isref('" & Left(MonthName(Month(Target)), 3) & "'!A1)") Then
                    Set ws = Sheets(Left(MonthName(Month(Target)), 3))
                    With ws
                        Target.Offset(, -1).Resize(, 6).Copy .Cells(.Rows.Count, "A").End(xlUp)
                        .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = "LTT"
                        .Cells(.Rows.Count, "E").End(xlUp).Offset(1).Formula = WorksheetFunction.Sum(.Range("E2", .Range("E" & .Rows.Count).End(xlUp)))
                        .Cells.WrapText = False
                        .Columns.AutoFit
                    End With
                    Set ID = Sheets(Left(MonthName(Month(Range("AA1"))), 3)).Range("A:A").Find(Target.Offset(, -1), LookIn:=xlValues, lookat:=xlWhole)
                    ID.EntireRow.Delete
                Else
                    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Left(MonthName(Month(Target)), 3)
                    With ActiveSheet
                        Sheets("ENTER").Range("A1:F1").Copy .Range("A1")
                        Target.Offset(, -1).Resize(, 6).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                        .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = "LTT"
                        .Cells(.Rows.Count, "E").End(xlUp).Offset(1).Formula = WorksheetFunction.Sum(.Range("E2", .Range("E" & .Rows.Count).End(xlUp)))
                        .Columns.AutoFit
                    End With
                    Set ID = Sheets(Left(MonthName(Month(Range("AA1"))), 3)).Range("A:A").Find(Target.Offset(, -1), LookIn:=xlValues, lookat:=xlWhole)
                    ID.EntireRow.Delete
                End If
            End If
        Case Is = 3, 4, 5, 6
            Set ws = Sheets(Left(MonthName(Month(Range("B" & Target.Row))), 3))
            Set ID = ws.Range("A:A").Find(Range("AA1"), LookIn:=xlValues, lookat:=xlWhole)
            ws.Cells(ID.Row, Target.Column) = Target
    End Select
    Range("AA1").ClearContents
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub