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

Closed
deadxcell Posts 1 Registration date Tuesday January 19, 2021 Status Member Last seen January 19, 2021 - Jan 19, 2021 at 01:39 PM
vcoolio Posts 1409 Registration date Thursday July 24, 2014 Status Moderator Last seen May 23, 2024 - Jan 20, 2021 at 05:59 AM
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 response

vcoolio Posts 1409 Registration date Thursday July 24, 2014 Status Moderator Last seen May 23, 2024 262
Jan 20, 2021 at 05:59 AM
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.
0