Excel - Add a blank row when letter of alphabet changes in list

[Mel_P]

Hello - I have an attendance list in excel which is sorted alphabetically. I wish to insert a blank row at each starting letter (A, blank row Bs etc.) change for the surname. I have found so VBA that enables me to insert a row but don't know how to use this to insert a new row at a letter change.

We search didn't produce any useable info.

Any suggestions please?

Thanks, Mel

 

[AHarvey]

So you're wanting to group all the A surnames together, all the B surnames together etc? Is there a reason for doing this via vba instead of manually as it's not a massive task adding 25 blank rows.

To do it automatically you need to take the current cell, extract the first letter and then compare it to the extracted first letter of the cell above. If they are different, add a blank link before it, otherwise, move on to the next cell.

 

[Grrrrr]

Sub AddRows()

Dim Rng As Range

Set Rng = Range("A2")

Do Until Rng = ""
   
    If Left(Rng, 1) <> Left(Rng.Offset(-1), 1) Then
        Rng.EntireRow.Insert
    End If
   
    Set Rng = Rng.Offset(1)
Loop

End Sub

Loops through each cell in column A. If the first letter of the cell doesn't match the first letter of the previous cell it inserts a row. It stops when it gets to a blank cell (the end of the list).

 

[Mel_P]

So you're wanting to group all the A surnames together, all the B surnames together etc? Is there a reason for doing this via vba instead of manually as it's not a massive task adding 25 blank rows. To do it automatically you need to take the current cell, extract the first letter and then compare it to the extracted first letter of the cell above. If they are different, add a blank link before it, otherwise, move on to the next cell.

Thanks. I have done it manually but as I would have to do this 12 times a year I thought - there must be an automated way!

Having a space means its easier for the "Attendance Monitor" to find a name!

 

[Mel_P]

Sub AddRows()

CODE

End Sub

Loops through each cell in column A. If the first letter of the cell doesn't match the first letter of the previous cell it inserts a row. It stops when it gets to a blank cell (the end of the list).

Thanks. Will try this evening! Mel

 

[Mel_P]

Excellent. Works a treat. OK so I now have the As names (in column B) / Blank Row / The Bs names / Blank Row, etc. What I would like to do then is to put a Letter A, B in the otherwise empty column A. How would I do this? Any ideas please?

A

Acvb
Axdnn
Another
Ant​

B

Bee
Bunting
Broke
Bent​

C

I don't know enough about VBA to get the logic of this - I have ordered "VBA for Dummies" from the library to get some background knowledge to this double dutch. I used to do a lot of Visual Basic years ago but am feeling a bit rusty!

Yours grovelingly, Mel

 

[Grrrrr]

Sub AddRows()

Dim Rng As Range

Set Rng = Range("B2")

Do Until Rng = ""

If Left(Rng, 1) <> Left(Rng.Offset(-1), 1) Then
Rng.EntireRow.Insert
End If

Rng.Offset(-1,-1).Value = Left(Rng, 1)

Set Rng = Rng.Offset(1)
Loop

End Sub

Your list of names is in column B so I've changed the starting cell to B2. After adding the empty row, the yellow line of code then puts the first letter of the surname in the cell left one, up one (hence -1, -1). I've not checked if this works but at least it'll give you something to work from. One other thing, you can use F8 to step through the code line by line. That should help you to see if it's working as expected.

 

[Mel_P]

Snzzzz. Going off and heard ping. Thanks - will try tomorrow! Mel

 

[Mel_P]

Tried having a play to see if I could do it (with some Web help) and this is probably a bit clunky but works!

Sub ADDROW()
Dim Rng As Range
Dim N As Integer

N = 1

Set Rng = Range("B2")

Do Until Rng = ""
If Left(Rng, 1) <> Left(Rng.Offset(-1), 1) Then
Rng.EntireRow.Insert
N = N + 1
Cells(N, 1).Font.Bold = True
Cells(N, 1).Font.Size = 12
Cells(N, 1) = Left(Rng, 1)
End If

N = N + 1
Set Rng = Rng.Offset(1)

Loop

End Sub

Will have a go your way now. This puts "A", "B" etc in bold and font size 12 in 1st column. The "N" counter is to keep alphabet letter in sync with blank row

Thanks, Mel

 

[Mel_P]

Yep - yours is more elegant BUT the line

Rng.Offset(-1,-1).Value = Left(Rng, 1)

needs moving between these 2 lines:

Rng.EntireRow.Insert
HERE
End If

OR it appears multiple times!

Thanks again.

 

[Mel_P]

Tried it on my full spreadsheet of 200 names and works fine.

An added refinement I put in my manually created version was a thick line along the top of the cells at the end of the "letter" group. Looking at examples this seems a bit complicated in VBA? Some code help would be useful here please?

 

[Grrrrr]

I recorded a macro where I simply gave the selected range a thick top border. This is what Excel spat out:

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlMedium
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Which is pretty complicated. The only lines you actually need are:

With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

And modified to plug into your code above:

With Range(Cells(N,1),Cells(N,2)).Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

 

[Mel_P]

Will try tomorrow!! Thanks. Mel

 

[Mel_P]

Hadn't thought of looking at "recorded" Macro. Learning!

The modified code (using Cells( etc.) put just after the font commands in the IF..... End IF block works just fine! It puts a line at the top of the row with the letter identifier.

Thanks very much. Could not have achieved this on this time scale without your help. OCUK forum invariably has somebody who can help (AND free postage on my TeamGroup SSD last week).

Mel