ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Tricky Tricky episode 2!!! (https://www.excelbanter.com/excel-programming/367860-re-tricky-tricky-episode-2-a.html)

Bernie Deitrick

Tricky Tricky episode 2!!!
 
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





All times are GMT +1. The time now is 05:43 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com