Tricky Tricky episode 2!!!

**mhax** · 07-20-2006, 01:44 PM

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!

Bernie Deitrick · 07-20-2006, 02:05 PM

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" <[email protected]> wrote in message
news:[email protected]...
>
> 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
>

Bernie Deitrick · 07-20-2006, 02:15 PM

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
news:[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
>>
>> 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** · 07-20-2006, 03:10 PM

Your code is working great, but it's not checking the value in colomn seven(G) as the previous code was doing (>> vValue = .Cells(lCurrRow, 7).Value
>> If Len(vValue) > 0 And IsNumeric(vValue) Then)

>> 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 1
>> U 442 2006-01-09 13:00:00 0

>> 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 1
>> U 442 2006-01-08
>> U 442 2006-01-09 13:00:00 0

Have to look like this! I need like a fusion of the two codes! I have to look at the values (1,2,3, etc) in column 7, and insert that amount of row. But it has to also put the date missing!

Thanks for the help! I really do appreciate!

Mhax

Originally Posted by Bernie Deitrick

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
news:[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
>>
>> 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** · 07-20-2006, 05:19 PM

Did you understand what i meant?

Originally Posted by Bernie Deitrick

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
news:[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
>>
>> 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
>>
>
>

Bernie Deitrick · 07-21-2006, 08:20 AM

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" <[email protected]> wrote in message
news:[email protected]...
>
> 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
>> news:[email protected]...
>> > 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" <[email protected]> wrote in
>> message
>> > news:[email protected]...
>> >>
>> >> 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
>

**mhax** · 07-21-2006, 10:15 AM

ok yeah! But it has to insert rows only if there is a number corresponding in the column F (1,2,3,etc)! Do you have an idea for the fusion of my macro and yours?

thanks!

Originally Posted by Bernie Deitrick

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" <[email protected]> wrote in message
news:[email protected]...
>
> 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
>> news:[email protected]...
>> > 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" <[email protected]> wrote in
>> message
>> > news:[email protected]...
>> >>
>> >> 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
>