Conditionally Copy rows to new sheet in Excel 2007

[souvick]

Hi,

I am trying to write a VBA Macro for the attached template wherein the objective is to filter the rows based on the Month Column and copy them to new sheet.

The number of rows and column can vary in the original file but the filtering criteria remains the same i.e. on Month.

I want the rows to be copied to new sheets in the excel for each month.

For example in the template, five rows have Jan-12 in month. I want them to be copied to new sheet called Jan12 and all five rows copied there. Similarly for Feb12 and so on.

The number of sheets should automatically added based on months.

Please help.

Thanks in Advance

Regards
Paul

[Steffen Thomsen]

Hi,

Try running the code in this workbook and se if it does whats required!

Steffen Thomsen

[souvick]

Hi,

Try running the code in this workbook and se if it does whats required!

Steffen Thomsen

Thanks a lot Steffen...

It works as expected.

Only a query..once the sheets are generated and I run the macro once again through a button click, same entry is made on the existing sheets and the data is duplicated.

I mean when I first run the macro, 4 new sheets are generated with 4 months. I then run the macro again, and on the same 4 sheets the rows are repeated.

Anyway I can prevent this, so that if someone clicks the button again and the macro runs, it should delete the existng sheets and generate the new sheets.

Or can you help me add one more macro to delete the existing sheets apart from the main sheet?

Thanks in advance

Regards
Souvick

[Steffen Thomsen]

Then use this code!

Sub steffen()

uRows = Application.WorksheetFunction.CountA(Sheets(1).Range("F1:F60000"))
Dim sheetArr() As String
Dim wSheet As Worksheet

Application.DisplayAlerts = False
For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next i
Application.DisplayAlerts = True

For Each cell In Range("F2:F" & uRows)
        On Error Resume Next
        Set wSheet = Sheets(Format(cell, "mmm-yyyy"))
        If wSheet Is Nothing Then 'Doesn't exist
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Format(cell, "mmm-yyyy")
            Sheets(1).Range("A1").EntireRow.Copy
            ActiveSheet.Range("A1").PasteSpecial
            cell.EntireRow.Copy
            With Sheets(Format(cell, "mmm-yyyy"))
                .Range("A60000").End(xlUp).Offset(1, 0).PasteSpecial
            End With
        Else
            cell.EntireRow.Copy
                With Sheets(Format(cell, "mmm-yyyy"))
                    .Range("A60000").End(xlUp).Offset(1, 0).PasteSpecial
                End With
        End If
Next cell

End Sub

Steffen Thomsen

[souvick]

Excellent,

This just serves the purpose. I think I should be able to learn quite fast on this forum.

Thanks a ton Steffen.

Kind Regards
Paul

[souvick]

********accidental repeat post*************
Please see the post below

[Steffen Thomsen]

Your welcome!

If the answer was satisfied, then please mark the thread as solved according to the forum rules

Steffen Thomsen

[souvick]

Hi Steffen,

Now the problem is unique. I added few more rows into the Sheet 1 with month May,Jun,Jul and Aug entries.

Then on running the macro, it still generates only 4 sheets from Jan to Apr.

How to adapt the macro to consider the new row entries as well?

Thanks in Advance

Regards
Paul

[Steffen Thomsen]

The code works for more than 4 sheets as it is, have you made any alterations to the code?

[souvick]

Hi Steffen,

Please see the attached template.

I just added few more rows of input data and clicked on the button to run the macro. Still it shows only 4 sheets till Apr and doesn't reflect the new entries of May, Jun,Jul and Aug as can be seen on Sheet 1.


Thanks in Advance

Regards
Paul

[Steffen Thomsen]

Sorry, just missed a thing!

Sub steffen()

uRows = Application.WorksheetFunction.CountA(Sheets(1).Range("F1:F60000"))
Dim sheetArr() As String
Dim wSheet As Worksheet

Application.DisplayAlerts = False
For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next i
Application.DisplayAlerts = True

For Each cell In Range("F2:F" & uRows)
        On Error Resume Next
        Set wSheet = Sheets(Format(cell, "mmm-yyyy"))
        If wSheet Is Nothing Then 'Doesn't exist
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Format(cell, "mmm-yyyy")
            Sheets(1).Range("A1").EntireRow.Copy
            ActiveSheet.Range("A1").PasteSpecial
            cell.EntireRow.Copy
            With Sheets(Format(cell, "mmm-yyyy"))
                .Range("A60000").End(xlUp).Offset(1, 0).PasteSpecial
            End With
        Else
            cell.EntireRow.Copy
                With Sheets(Format(cell, "mmm-yyyy"))
                    .Range("A60000").End(xlUp).Offset(1, 0).PasteSpecial
                End With
        End If
        Set wSheet = Nothing
Next cell

End Sub

[souvick]

Thanks a lot,

Now it works just as expected. Appreciate your helping a novice like me.


Kind Regards
Paul

[souvick]

Hi Steffen,

If you don't mind me asking, the only difference I see here is the initialization of wSheet. Since I am newly exposed to excel programming, can you please help me understand how does that help in getting the data refreshed in Sheet 1 as was the problem earlier?

Thanks in Advance

Kind Regards
Souvick

[Steffen Thomsen]

Hi,

Before each cell evaluation im resetting the variable wSheet, look at this line at the bottom of the code

Set wSheet = Nothing

[TghFox]

Hi ,

I've tried changing the data line with the first code, and obtain different results, finally, I understand the combination function of "On Error", "set wSheet" , "for each"

thanks for the quick reply, Steffen

[Steffen Thomsen]

No, it just means that if wSheet is not reset the check at the top for the existence of the sheet doens't work properly