Separate based on months and add the entire row values from header to a new sheet.

[GirishDhruva]

Hi Everyone,

I have a huge data which i need to separate based on months and create a new sheet with the name of the month(Assume if i have date like 01-04-2019 then sheet name should be like "Apr'19") and add the entire row value including header to that sheet.

If i have more than one data for the same month then it should add the entire row in the worksheet which is already created.

Can this be done in VBA code

Billing Name	Invoice Number	Invoice Date	Client Name	Type	Service
asd	1	03-04-2019	qwe	poi	xyz
sdf	2	21-01-2020	wer	oiu	yui
dfg	3	29-04-2019	ert	iuy	abc
fgh	4	02-02-2020	rty	uyt	cde
ghj	5	18-08-2019	tyu	ytr	vgt

Regards,
Dhruva.

 

[Yard]

Hi, this sounds like a job for a PivotTable

 

[mumps]

Try this macro. Change the sheet name containing your data (in red) to suit your needs.

Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object, LastRow As Long, ws As Worksheet, item As Variant, lDateFrom As Long
    Dim lDateTO As Long, Val As String, srcWS As Worksheet
    Set srcWS = Sheets("Sheet1")
    Set RngList = CreateObject("Scripting.Dictionary")
    LastRow = srcWS.Cells(Rows.Count, "A").End(xlUp).Row
    For Each Rng In srcWS.Range("C2:C" & LastRow)
        Val = Month(Rng) & "|" & Year(Rng)
        If Not RngList.Exists(Val) Then
            lDateFrom = DateSerial(Year(Rng), Month(Rng), 1)
            lDateTO = DateSerial(Year(Rng), Month(Rng) + 1, 0)
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(Format(Rng, "mmm, yy"))
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Format(Rng, "mmm, yy")
                With srcWS.Cells(1).CurrentRegion
                    .AutoFilter Field:=3, Criteria1:=">=" & lDateFrom, Operator:=xlAnd, Criteria2:="<=" & lDateTO
                    srcWS.AutoFilter.Range.Copy Cells(1, 1)
                End With
            End If
        End If
    Next Rng
    If srcWS.AutoFilterMode Then srcWS.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[GirishDhruva]

Try this macro. Change the sheet name containing your data (in red) to suit your needs.

Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object, LastRow As Long, ws As Worksheet, item As Variant, lDateFrom As Long
    Dim lDateTO As Long, Val As String, srcWS As Worksheet
    Set srcWS = Sheets("Sheet1")
    Set RngList = CreateObject("Scripting.Dictionary")
    LastRow = srcWS.Cells(Rows.Count, "A").End(xlUp).Row
    For Each Rng In srcWS.Range("C2:C" & LastRow)
        Val = Month(Rng) & "|" & Year(Rng)
        If Not RngList.Exists(Val) Then
            lDateFrom = DateSerial(Year(Rng), Month(Rng), 1)
            lDateTO = DateSerial(Year(Rng), Month(Rng) + 1, 0)
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(Format(Rng, "mmm, yy"))
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Format(Rng, "mmm, yy")
                With srcWS.Cells(1).CurrentRegion
                    .AutoFilter Field:=3, Criteria1:=">=" & lDateFrom, Operator:=xlAnd, Criteria2:="<=" & lDateTO
                    srcWS.AutoFilter.Range.Copy Cells(1, 1)
                End With
            End If
        End If
    Next Rng
    If srcWS.AutoFilterMode Then srcWS.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

Hi @mumps it works fine but if my header is merged of two rows then what changes should i make and i need to find the column total at the last for particular columns (i.e, column number from 8-12 and 17-22)

Regards,
Dhruva.

 

[GirishDhruva]

Please refer below:

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Regards,
Dhruva.

 

[mumps]

Click here to download your file. Merged cells almost always create problems for Excel macros and you should avoid using them at all cost. I have unmerged all the merged cells.

i need to find the column total at the last for particular columns (i.e, column number from 8-12 and 17-22)

Could you please clarify in detail what you mean by the above quote? Are you saying that you want to find the totals for certain columns in the newly created sheets? If so, which columns? How many columns do you have in your actual File?

 

[GirishDhruva]

Click here to download your file. Merged cells almost always create problems for Excel macros and you should avoid using them at all cost. I have unmerged all the merged cells.

Could you please clarify in detail what you mean by the above quote? Are you saying that you want to find the totals for certain columns in the newly created sheets? If so, which columns? How many columns do you have in your actual File?

Sorry for the late reply.

I have 30 columns in that i need to calculate sum of the columns which i have already mentioned in above.

 

[mumps]

The last file you attached has only 12 columns. Please attach a version that has the 30 columns including the data.

 

[GirishDhruva]

Please check with the below attached file.

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Regards,
Dhruva.

 

[mumps]

Click here for your file. I would suggest that you always use the attached version because the file you posted had merged cells so I had to unmerge them again.