VBA - Insert A Row before every month

[drcoz]

I have a spreadsheet for when employee's birthdays are. I've gotten everything but now I need to insert the name of the Month on a line before the month and looking for some VBA code to do this. I'm using 365 Excel and can not use a macro due to computer security but I can use VBA.

My raw data looks like this:

The End state I want is this:

The empty columns I need, I just removed the data for privacy concerns.

As you can see I'm able to sort the list just stuck on how to insert the Month lines in my final example. I've done several searches on line but the codes I find don't do what I want or don't work at all.

Thanks for your assistance and time.

 

[Candyman8019]

try something like this:

Private Sub insertline()
Dim rng As Range
Dim cell As Range

Set rng = Sheet12.Range("D2:D50")

For Each cell In rng
 
 If Left(cell.Value, 3) <> Left(cell.Offset(-1, 0).Value, 3) And cell.Offset(-1, 0).Value <> "" Then
   cell.EntireRow.Insert
 End If
Next cell
End Sub

 

[drcoz]

It sort of worked but not the way I need it to work.

I need to keep all of Jan together, then a line break, then all of Feb. Currently it's breaking the month of Jan more, see below:

I also need when the line is added to automatically add the month name, like JAN, FEB, MAR, etc...

 

[Candyman8019]

Here's updated code to add the month in column A. As for why it's splitting January...I wonder if there are spaces before the text. To rule that out, I have added some trims. Try this:

Private Sub insertline()
Dim rng As Range
Dim cell As Range

Set rng = Sheet12.Range("D2:D30")

For Each cell In rng
 
 If Left(Trim(cell.Value), 3) <> Left(Trim(cell.Offset(-1, 0).Value), 3) And cell.Offset(-1, 0).Value <> "" Then
   cell.EntireRow.Insert
   cell.Offset(-1, -3).Value = Left(Trim(cell.Value), 3)
 End If
Next cell
End Sub

 

[drcoz]

No, still putting in too many spaces and putting month and day on the blank line as well.

 

[Candyman8019]

Okay, the problem is that it was reading the dates in numerical format. Give this a go:

Private Sub insertline()
Dim rng As Range
Dim cell As Range

Set rng = Sheet12.Range("D2:D30")

For Each cell In rng
 If cell.Offset(-1, 0).Value <> "" Then
   If Left(Format(cell.Value, "MMM"), 3) <> Left(Format(cell.Offset(-1, 0).Value, "MMM"), 3) Then
     cell.EntireRow.Insert
     cell.Offset(-1, -3).Value = Left(Format(cell.Value, "MMM"), 3)
   End If
 End If
Next cell
End Sub

 

[drcoz]

BINGO! Thanks worked! Thanks for the help on this one!!!

 

[Candyman8019]

Happy to help...