VBA- Insert 3 blank rows based on date

[DynamiteHack]

I have run into a bit of a wall with this one...I have a list of items that were printed and a date timestamp on each line. My goal is to scan down the rows and insert 3 blank rows after each date change.
I have found a way to insert a blank row after unique values. Code is below. ..

Sub insertem()
    Dim r As Long
    For r = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If range("J" & r).Value <> range("J" & r - 1) Then
            Rows(r).Insert
        End If
     Next r
End Sub

Unfortunately, this code inserts a blank row after every line because of the time portion of the stamp and I believe it is compared to the data in column A. This isn't exactly what I'm trying to do, but it got me closer. The trouble that I'm having is figuring out a strategy of looking at just the date portion of the stamp and inserting the blank rows between different dates. Here is a snippet of data, any advice would be much appreciated!!

[TABLE="width: 336"]
<tbody>[TR]
[TD="width: 88"]PickList[/TD]
[TD="width: 88"]GOOD[/TD]
[TD="class: xl65, width: 160, align: right"]10/6/2014 16:49[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/6/2014 16:49[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/6/2014 16:49[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/6/2014 16:49[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/6/2014 16:49[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/7/2014 9:00[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/7/2014 9:00[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/7/2014 9:00[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/7/2014 9:00[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/7/2014 9:00[/TD]
[/TR]
[TR]
[TD]PickList[/TD]
[TD]GOOD[/TD]
[TD="class: xl65, align: right"]10/7/2014 9:00[/TD]
[/TR]
</tbody>[/TABLE]

 

[Peter_SSs]

Does this modification do what you want?

Sub insertem()
    Dim r As Long
    
    For r = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Int(Range("J" & r).Value) <> Int(Range("J" & r - 1)) Then
            Rows(r).Resize(3).Insert
        End If
    Next r
End Sub

 

[DynamiteHack]

Thanks for the quick reply, Peter! Sorry mine wasn't the same!!
It did exactly what I was hoping for, though it ended with a type mismatch.

Run-time error '13':
Type mismatch

Not sure what threw that out, but this is awesome, thanks very much!!
'hack

 

[Peter_SSs]

... it ended with a type mismatch.

Run-time error '13':
Type mismatch

Not sure what threw that out,..

I should have thought of that. No doubt you have a text heading in cell J1. When the code gets to row 2 it tries to take the integer part of J2 and J1 and compare them but of course if J1 is not numerical this error will occur.

Do you want 3 blank rows between the heading and the first data row?
Assuming you don't, then just change your loop to stop at row 3

For r = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1

 

[Livin404]

It looked like you answered the same exact question I was looking for, I got the same error code as the first guy you helped. I attached an image of the column I wanted separated (D). I would like to have them separated by the date not the time. Thank you! I used this code.

Sub InsertBlankRow()

    Dim r As Long
    
    For r = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
        If Int(Range("D" & r).Value) <> Int(Range("D" & r - 1)) Then
            Rows(r).Resize(1).Insert
        End If
    Next r
End Sub

 

[Peter_SSs]

I attached an image of the column I wanted separated

No image?

 

[Livin404]

No image?

Sorry about that, I've been spending hours on this, so annoying.

 

[Peter_SSs]

Bit of a guess, but it looks like your column D data might be text, not numeric. If that is so, then try making this change.

If Int(Range("D" & r).Value) <> Int(Range("D" & r - 1)) Then
If Left(Range("D" & r).Value, 11) <> Left(Range("D" & r - 1).Value, 11) Then

Also, since it appears that you do not have a heading row, you may want to make this change

For r = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1

 

[Livin404]

That was an incredibly good guess. It was spot on! Thank you so much. I've spent hours trying that out. I knew I would be getting close will I stumbled up this. I feel uneasy asking this, but I've been stuck on one other thing. I assure you I already have 9 macros now for this project I'm working on. The product now is really starting to take form.
In any case the question I have and it would be nice if you can offer any advice. The Column D , the one with the date and time are listed in GMT or Zulu time therefore I need to subtract 7 hours. The first one listed is 15 Oct 2020 0245 which means it will also change the date to 14 Oct. I'm looking for a code to change the time and if applicable the date will also move back. Once this is done then the blank rows will be inserted which we just did, then I'm going to remove the date and just leave the 24 hour time.

The formula I have which I know is way off is

Sub Roll_Call()

Dim Roll_Call As Date

Roll_Call = "mm.dd.yyyy hh:mm"

Range("D1") = DateAdd("mm.dd.yyyy hh:mm", -7, Roll_Call)

 End Sub

 

[Peter_SSs]

1. Do you want the altered date/times to replace the existing dates or do you want them in a new column? If new, which column?
2. Do you want the new date/times to be text values like the original ones or do you want them to be 'real' date/time values (numeric)?