Repeat each date specific number of times

[liakos]

Hello everybody!
I have gotten so much help form this forum from times to times, but this is the first time I am posting a question...
What I need is :

I have an excel file that is extracted from a machine, which records temperatures every 15 minutes per hour, 24 hours per day, every day per month... (96 rows per day)
In Column A we have the dates
01/09/2017 (x96 times)
02/09/2017 (x96 times)
...
...
...
30/09/2017 (x96 times)

Sometimes this machine stucks and stops recording, so till it gets back to work and start recording again, I have already missed some records, which I have to enter by hand.

So, I need a macro, to check if each date of the month has 96 rows in column A and if not then add the missing rows...It happens some dates to have 70 rows, so in that case I need the macro to insert another 26 rows of the same date...

I don't know if this is easy, but it would be very helpful if someone could give me a solution...
Thanks in advance guys!

 

[Fluff]

Cross posted https://www.ozgrid.com/forum/forum/...pears-and-if-is-less-than-x-times-insert-rows

Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[Dryver14]

Just make sure i = the first date you want 96 of:

Sub KWFillRows()


    Dim i As Long
    Dim x As Long
    
    i = 1
    x = 1
    
    Application.ScreenUpdating = False
    
    Do Until x = 96
    
        Cells(i, 1).Select
            If Cells(i + 1, 1) = Cells(i, 1) Then
                i = i + 1
                x = x + 1
            Else
                Cells(i + 1, 1).EntireRow.Insert
                Cells(i + 1, 1) = Cells(i, 1)
                i = i + 1
                x = x + 1
            End If
        If x = 96 Then
            Cells(i, 1).Offset(1, 0).Select
             x = 1
             i = i + 1
            If Cells(i, 1).Value = "" Then Exit Sub
        End If
    Loop
    
    Application.ScreenUpdating = True
End Sub

 

[liakos]

@Dryver14
Hey mate!
The code works almost perfect!!! Thanks a lot for your effort / time...
What this code is missing, is when a date of a month is completely missing, it will not fill it between the other dates...
e.g.: lets say we work on September and the date 25/09/2017 is totally missing form my excel...the code will do everything with all the other dates that already exist (at least for 1 row), but it will not add the totally missing date 96 times...
If it is easy to help me do this, I would be gratefull!!!
Thanks again...hope I explained well what I finally need...

 

[Dryver14]

this should do it

Sub KWFillRows()


    Dim i As Long
    Dim x As Long
    
    i = 1
    x = 1
    
    Application.ScreenUpdating = False
    
    Do Until x = 96
    
        Cells(i, 1).Select
            If Cells(i + 1, 1) = Cells(i, 1) Then
                i = i + 1
                x = x + 1
            Else
                Cells(i + 1, 1).EntireRow.Insert
                Cells(i + 1, 1) = Cells(i, 1)
                i = i + 1
                x = x + 1
            End If
        If x = 96 Then
            If Cells(i + 1, 1).Value = "" Then Exit Sub
            If Cells(i, 1).Offset(1, 0).Value = Cells(i, 1).Value + 1 Then
                Cells(i, 1).Offset(1, 0).Select
                x = 1
                i = i + 1
            If Cells(i, 1).Value = "" Then Exit Sub
                Else
                    
                    Cells(i + 1, 1).EntireRow.Insert
                    Cells(i + 1, 1).Value = Cells(i, 1).Value + 1
                    i = i + 1
                    x = 1
                    
                End If
            End If
    Loop
    
    Application.ScreenUpdating = True
End Sub

 

[Dryver14]

I had a little play with times. If you to use it then format the first cell of the first time as 00:00
and then run this. It will put times in from 00:00 to 23:45 in 15 minute increments fro each day

Sub FillTimes()


Dim LastRow As Long
Dim i As Long       
Dim x As Integer   
Dim y As Integer


LastRow = Cells(Rows.Count, 1).End(xlUp).Row 
 x = 1 
 y = 0
    For i = 1 To LastRow
    
       
            Select Case x
                Case 1
                    Cells(i, 2).Value = y & ":00"
                Case 2
                    Cells(i, 2).Value = y & ":15"
                 Case 3
                    Cells(i, 2).Value = y & ":30"
                 Case 4
                    Cells(i, 2).Value = y & ":45"
            End Select
        
       x = x + 1
       If x = 5 Then y = y + 1
       
       If x = 5 Then x = 1
       If y = 24 Then y = 0
    Next i
    
End Sub