Formulae for Macro - Can you Help need some help!

[midfieldgeneral11]

Hello can you help?

I need to write a macro which is hard for me but could be easier for all you excel wizards.

Please see the able below which is a table containing who is on Holiday within my Department for the different Months.

This spreadsheet is a download from a system but the Months are not split out and what I want is to split out every time there is a month change.

This table is just showing the first column but the range I need to cut will always be from A to AM

I have a list of people as listed below which starts at January 2007 and goes down and then starts at February 2007 and then restarts at each month till December.

What I need is?

To be able run a macro to cut or copy all information from the January cell to the end of the names/start of the next month. This may change so therefore it may not be A3 –A11 could be A5-A13. So I need the macro to know when there is a new month etc.

This is one spreadsheet and what I require is to split this into 12 months which can be then renamed for each month.

So I need a code to cut it at each month?

Hope this explains all. Thanks for looking and hopefully your help.

[Bad HTML example removed by admin]

 

[Jon von der Heyden]

No doubt there's a far shorter and easier way of doing this but here's my crack at it

Sub midfieldgeneral11()

Dim Rng1 As Long, Rng2 As Long

'---------JANUARY----------
Rng1 = Range("A:A").Find(What:="January").Row
Rng2 = Range("A:A").Find(What:="February").Row - 1
    
Sheets.Add
ActiveSheet.Name = "January"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("January").Range("A1"))

'---------FEBRUARY----------
Rng1 = Range("A:A").Find(What:="February").Row
Rng2 = Range("A:A").Find(What:="March").Row - 1
    
Sheets.Add
ActiveSheet.Name = "February"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("February").Range("A1"))

'---------MARCH----------
Rng1 = Range("A:A").Find(What:="March").Row
Rng2 = Range("A:A").Find(What:="April").Row - 1
    
Sheets.Add
ActiveSheet.Name = "March"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("March").Range("A1"))

'---------APRIL----------
Rng1 = Range("A:A").Find(What:="April").Row
Rng2 = Range("A:A").Find(What:="May").Row - 1
    
Sheets.Add
ActiveSheet.Name = "April"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("April").Range("A1"))

'---------MAY----------
Rng1 = Range("A:A").Find(What:="May").Row
Rng2 = Range("A:A").Find(What:="June").Row - 1
    
Sheets.Add
ActiveSheet.Name = "May"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("May").Range("A1"))

'---------JUNE----------
Rng1 = Range("A:A").Find(What:="June").Row
Rng2 = Range("A:A").Find(What:="July").Row - 1
    
Sheets.Add
ActiveSheet.Name = "June"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("June").Range("A1"))

'---------JULY----------
Rng1 = Range("A:A").Find(What:="July").Row
Rng2 = Range("A:A").Find(What:="August").Row - 1
    
Sheets.Add
ActiveSheet.Name = "July"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("July").Range("A1"))

'---------AUGUST----------
Rng1 = Range("A:A").Find(What:="August").Row
Rng2 = Range("A:A").Find(What:="September").Row - 1
    
Sheets.Add
ActiveSheet.Name = "August"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("August").Range("A1"))

'---------SEPTEMBER----------
Rng1 = Range("A:A").Find(What:="September").Row
Rng2 = Range("A:A").Find(What:="October").Row - 1
    
Sheets.Add
ActiveSheet.Name = "September"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("September").Range("A1"))

'---------OCTOBER----------
Rng1 = Range("A:A").Find(What:="October").Row
Rng2 = Range("A:A").Find(What:="November").Row - 1
    
Sheets.Add
ActiveSheet.Name = "October"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("October").Range("A1"))

'---------November----------
Rng1 = Range("A:A").Find(What:="November").Row
Rng2 = Range("A:A").Find(What:="December").Row - 1
    
Sheets.Add
ActiveSheet.Name = "November"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("November").Range("A1"))

'---------December----------
Rng1 = Range("A:A").Find(What:="December").Row
Rng2 = Range("A:A").Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
Sheets.Add
ActiveSheet.Name = "December"
Sheets("Sheet1").Activate '<-------------- change this sheet name to the name of your sheet

Range("A" & Rng1 & ":AM" & Rng2).Copy (Sheets("December").Range("A1"))

End Sub

Edit: Suppose some sort of For i = 1 to 12 could've done the trick

 

[gingersteve]

Shorter code that allows for less than the full 12 months:

Public Sub Split()
Dim MthArray As Variant
Dim intMth As Integer
Dim lngStartRow, lngEndRow As Long
Dim shtNew, shtStart As Worksheet
Set shtStart = ActiveSheet
MthArray = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
For intMth = 0 To 11
    If shtStart.Range("A:A").Find(MthArray(intMth + 1)) Is Nothing Then Exit For
    lngStartRow = shtStart.Range("a:a").Find(MthArray(intMth)).Row
    lngEndRow = shtStart.Range("A:A").Find(MthArray(intMth + 1)).Row - 1
    shtStart.Range(lngStartRow & ":" & lngEndRow).Cut
    Set shtNew = ActiveWorkbook.Worksheets.Add
    shtNew.Name = MthArray(intMth)
    shtNew.Paste
    shtStart.Range(lngStartRow & ":" & lngEndRow).Delete
Next intMth
shtStart.Name = MthArray(intMth)
For intName = intMth - 1 To 0 Step -1
    Sheets(MthArray(intName)).Move before:=Sheets(MthArray(intName + 1))
Next intName
End Sub

 

[midfieldgeneral11]

~Hello Ginger Steve this worked a treat apart from a debug message appeared. i wanted to add some formatting to the end of it but it came up with the following:

Would you know how just stop and not debug?

It come up Run Time Error 9 Subscript out of Range?

The code it stops on is

If shtStart.Range("A:A").Find(MthArray(intMth + 1)) Is Nothing Then

Can you help?

You have been superb here this would be great

Simon

 

[gingersteve]

My apologies, I was testing it on your published part sheet and didn't try it with all months to December. The following should now work

Public Sub Split()
Dim MthArray As Variant
Dim intMth As Integer
Dim lngStartRow, lngEndRow As Long
Dim shtNew, shtStart As Worksheet
Set shtStart = ActiveSheet
MthArray = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
For intMth = 0 To 10
    If shtStart.Range("A:A").Find(MthArray(intMth + 1)) Is Nothing Then Exit For
    lngStartRow = shtStart.Range("a:a").Find(MthArray(intMth)).Row
    lngEndRow = shtStart.Range("A:A").Find(MthArray(intMth + 1)).Row - 1
    shtStart.Range(lngStartRow & ":" & lngEndRow).Cut
    Set shtNew = ActiveWorkbook.Worksheets.Add
    shtNew.Name = MthArray(intMth)
    shtNew.Paste
    shtStart.Range(lngStartRow & ":" & lngEndRow).Delete
Next intMth
intMth = intMth - 1
shtStart.Name = MthArray(intMth + 1)
For intName = intMth To 0 Step -1
    Sheets(MthArray(intName)).Move before:=Sheets(MthArray(intName + 1))
Next intName
End Sub

 

[midfieldgeneral11]

Thanks very much with all your help ginger steve you are the master!

This worked a treat. If possible could I email you in the future if I have any thing that is tricky like this.

You are a genius and appreciate all your help. Sorry I did not come back to you sooner.

Kind Regards

Midifeldgeneral11