Macro to insert row based on variable cell value (text)

Report
Posts
1
Registration date
Tuesday January 19, 2021
Status
Member
Last seen
January 19, 2021
-
Posts
1271
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
January 24, 2021
-
Hello,

I receive a large data file every week that needs to be formatted into an accounting journal entry. I have very basic VBA knowledge but it was way limited for this kind of macro.

Basically, I need to turn this:

A B C D
6000 9300 100 John Handcock
6000 9300 100 John Handcock
6000 9300 100 John Handcock
6000 9300 100 John Handcock
6000 9300 100 Susie Lin
6000 9300 100 Susie Lin
6000 9300 100 Susie Lin
6000 9300 100 Jamie Grey
6000 9300 100 Jamie Grey
6000 9300 100 Jamie Grey


Into this:

A B C D
6000 9300 100 John Handcock
6000 9300 100 John Handcock
6000 9300 100 John Handcock
6000 9300 100 John Handcock
<Insert Row>
6000 9300 100 Susie Lin
6000 9300 100 Susie Lin
6000 9300 100 Susie Lin
<Insert Row>
6000 9300 100 Jamie Grey
6000 9300 100 Jamie Grey
6000 9300 100 Jamie Grey


Any help is much appreciated!


Thanks.

1 reply

Posts
1271
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
January 24, 2021
217
Hello Deadxcell,

You could use a Do/While loop as follows:-

Sub Test()
        
        Dim Rw As Long
        Dim Rng As Range
        
        Set Rng = Sheet1.Range("A2") '---->Headings in Row1, data starts in Row2. Else, Rng = Sheet1.Range("A1")
        Rw = Rng.Row
        
        Do
        
            If Sheet1.Cells(Rw + 1, 4) <> Sheet1.Cells(Rw, 4) Then
                Sheet1.Cells(Rw + 1, 4).EntireRow.Insert
                Rw = Rw + 2
            Else
                Rw = Rw + 1
            End If
        
        Loop While Not Sheet1.Cells(Rw, 4) = vbNullString

End Sub


I'm assuming that your data starts in Row2 with headings in Row1.
The code works based on separating the data on the text (names) in Column D.
As I don't know what your sheet name is, I've used the sheet code (Sheet1) to fully qualify your "working sheet" in the code above.

I hope that this helps.

Cheerio,
vcoolio.

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!