I ignored the other conditional because your example did not include an extra column, and the
results did not seem to depend on the entries in the column to the right of the date.

HTH,
Bernie
MS Excel MVP


"mhax" wrote in message
...

Did you understand what i meant?

Bernie Deitrick Wrote:
Oops,

Forgot about the doubled dates...


Sub test()
Dim lLastRow As Long
Dim lCurrRow As Long
Dim vValue As Variant

Application.ScreenUpdating = False

With Worksheets("Sheet1")
lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row

For lCurrRow = lLastRow To 2 Step -1
If IsDate(Cells(lCurrRow - 1, 2).Value) And _
IsDate(Cells(lCurrRow, 2).Value) Then
If Cells(lCurrRow - 1, 2).Value < Cells(lCurrRow, 2).Value - 1 And _
Cells(lCurrRow - 1, 2).Value < Cells(lCurrRow, 2).Value Then
Cells(lCurrRow, 2).EntireRow.Insert
Cells(lCurrRow, 2).Value = Cells(lCurrRow + 1, 2).Value - 1
Cells(lCurrRow, 1).Value = Cells(lCurrRow + 1, 1).Value
lCurrRow = lCurrRow + 1
End If
End If
Next lCurrRow
End With

Application.ScreenUpdating = True
End Sub

HTH,
Bernie
MS Excel MVP


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Try the macro below.

HTH,
Bernie
MS Excel MVP

Sub test()
Dim lLastRow As Long
Dim lCurrRow As Long
Dim vValue As Variant

Application.ScreenUpdating = False

With Worksheets("Sheet1")
lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row

For lCurrRow = lLastRow To 2 Step -1
If IsDate(Cells(lCurrRow - 1, 2).Value) And _
IsDate(Cells(lCurrRow, 2).Value) Then
If Cells(lCurrRow - 1, 2).Value < Cells(lCurrRow, 2).Value - 1 Then
Cells(lCurrRow, 2).EntireRow.Insert
Cells(lCurrRow, 2).Value = Cells(lCurrRow + 1, 2).Value - 1
Cells(lCurrRow, 1).Value = Cells(lCurrRow + 1, 1).Value
lCurrRow = lCurrRow + 1
End If
End If
Next lCurrRow
End With

Application.ScreenUpdating = True
End Sub


"mhax" wrote in
message
...

I've been working on the code i received yesterday!

That's what i have right now!

U 442 2006-01-01 10:00:00 1
U 442 2006-01-04 16:00:00 1 2
U 442 2006-01-07 07:00:00 0
U 442 2006-01-07 22:00:00 1
U 442 2006-01-07 13:00:00 0

That's what i want!

U 442 2006-01-01 10:00:00 1
U 442 2006-01-04 16:00:00 1 2
U 442 2006-01-05
U 442 2006-01-06
U 442 2006-01-07 07:00:00 0
U 442 2006-01-07 22:00:00 1
U 442 2006-01-07 13:00:00 0

That's the code i'm using!

Sub test()
Dim lLastRow As Long
Dim lCurrRow As Long
Dim vValue As Variant

Application.ScreenUpdating = False

With Worksheets("Sheet1")
lLastRow = .Cells(.Rows.Count, 2).End(xlUp)

For lCurrRow = lLastRow To 1 Step -1
vValue = .Cells(lCurrRow, 7).Value
If Len(vValue) 0 And IsNumeric(vValue) Then
Cells(lCurrRow, 1).Resize(vValue, _
1).EntireRow.Insert shift:=xlUp
Cells(lCurrRow, 6).Resize(vValue, _
1).Value = 1440
Cells(lCurrRow, 1).Resize(vValue, _
1).Value = .Cells(lCurrRow - 1, 1)
Cells(lCurrRow, 2).Resize(vValue, _
1).Value = .Cells(lCurrRow - 1, 2) + 1
End If
Next lCurrRow
End With

Application.ScreenUpdating = True
End Sub

I cant find how make the new insert line go under, and i cant find
how
make the new dates fills up new blank cells! Need help! thanks!


--
mhax

------------------------------------------------------------------------
mhax's Profile:
http://www.excelforum.com/member.php...o&userid=36450
View this thread:
http://www.excelforum.com/showthread...hreadid=563411





--
mhax
------------------------------------------------------------------------
mhax's Profile: http://www.excelforum.com/member.php...o&userid=36450
View this thread: http://www.excelforum.com/showthread...hreadid=563411