Inscrutable error

[Jim Berglund]

I'm having a problem I can't solve.

Please do the following:
In a new worksheet
Fill Column A with any value down to row 36

In column L, place dates, as follows(row# is not important):
Row L
2 10/10/1993
3
4
5
6 5/4/2005
7 3/3/1993
8
9
10 12/3/2007
11 6/23/2000
12
13
14 8/8/2007
15 4/4/2001
etc.
for 36 rows ( the first of the pairs needs to be lower than the second, with
any number of blank cells between them)

Then run this code
Sub Prorate_Dates()

Dim RowCount, RowCount2, OldRow As Integer
Dim OldDate, NewDate, DeltaDate, MyDate As Variant
'On Error Resume Next
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

First = True
For RowCount = 2 To LastRow
If IsEmpty(Cells(RowCount, "A")) Then 'if last row was empty use todays
date to prorate
If IsEmpty(Cells(RowCount - 1, "L")) Then 'Use last NewDate to
prorate
OldDate = NewDate
NewDate = Now()
DeltaDate = (NewDate - OldDate) / _
(RowCount - OldRow)
'fill in prorated dates
For RowCount2 = OldRow To (RowCount - 1)

MyDate = Cells(RowCount2 - 1, "L") + _
DeltaDate
Cells(RowCount2, "L") = MyDate
Next RowCount2

End If
First = True 'Is it the first line of the series?
Else
If First = True Then

OldDate = Cells(RowCount, "L")
OldRow = RowCount
First = False
Else
If Not IsEmpty(Cells(RowCount, "L")) Then 'if the cell is empty,
go to the nect cell
NewDate = Cells(RowCount, "L") 'Otherwise select the last
date for the series
DeltaDate = (NewDate - OldDate) / (RowCount - OldRow) 'Calculate
the prorated difference between first & last and divide by the number of
empty lines

For RowCount2 = (OldRow + 1) To (RowCount - 1) 'fill in prorated
dates
MyDate = Cells(RowCount2 - 1, "L") + DeltaDate
Cells(RowCount2, "L") = MyDate
Next RowCount2

OldDate = NewDate
OldRow = RowCount
End If
End If
End If

Next RowCount

End Sub

It generates an error around line 26, and I can't understand why.

Please help!

Thanks
Jim Berglund

 

[RB Smissaert]

Put Option Explicit at the top of the module and alter the code till it will
compile.
Then try again.

RBS

 

[Ken]

Jim
It worked okay for me with several data sets. It must be something
about your data. What do you have in columns A and L?
Ken

 

[Jim Berglund]

Thanks, but it still won't work!

I did it, declared all my variables, recompiled, and ran it again with the
same result
Jim Berglund

 

[Jim Berglund]

Ken, I sent you a copy of the dataset with instructions. Please let me know
if you receive it...

Thanks,
Jim Berglund

 

[Jim Berglund]

I started with a clean Spreadsheet, entered data in Columns A and L, and ran
the program.

Once again, it worked - but only for the first 26 lines. Them I got the Type
Mismatch error again.

Jim Berglund

 

[RB Smissaert]

You will have to declare your variables like this:

Dim RowCount As Long
Dim RowCount2 As Long
Dim OldRow As Long
Dim OldDate As Long
Dim NewDate As Date
Dim DeltaDate As Date
Dim MyDate As Date
Dim LastRow As Long
Dim First As Boolean

And then either uncomment On Error Resume Next
or put some more If conditions in to avoid the errors
you are getting.

RBS

 

[RB Smissaert]

This works:

Sub Prorate_Dates()

Dim RowCount As Long
Dim RowCount2 As Long
Dim OldRow As Long
Dim OldDate As Long
Dim NewDate As Date
Dim DeltaDate As Date
Dim MyDate As Date
Dim LastRow As Long
Dim First As Boolean

'On Error Resume Next
10 LastRow = Cells(Rows.Count, 1).End(xlUp).Row

20 First = True
30 For RowCount = 2 To LastRow
40 If Cells(RowCount, 1) = "" Then 'if last row was empty use todays
date to prorate
50 If IsEmpty(Cells(RowCount - 1, 12)) Then 'Use last NewDate to
prorate
60 OldDate = NewDate
70 NewDate = Now()
80 DeltaDate = (NewDate - OldDate) / _
(RowCount - OldRow)
'fill in prorated dates
90 For RowCount2 = OldRow To (RowCount - 1)

100 MyDate = Cells(RowCount2 - 1, 12) + _
DeltaDate
110 Cells(RowCount2, 12) = MyDate
120 Next RowCount2

130 End If
140 First = True 'Is it the first line of the series?
150 Else
160 If First = True Then

170 OldDate = Cells(RowCount, 12)
180 OldRow = RowCount
190 First = False
200 Else
210 If Not Cells(RowCount, 12) = "" Then 'if the cell is empty,
go to the nect cell
220 NewDate = Cells(RowCount, 12) 'Otherwise select the
lastdate for the series
230 DeltaDate = (NewDate - OldDate) / (RowCount - OldRow)
'Calculate the prorated difference between first & last and divide by the
number of empty lines

240 For RowCount2 = (OldRow + 1) To (RowCount - 1) 'fill in
prorated dates
250 MyDate = Cells(RowCount2 - 1, 12) + DeltaDate
260 Cells(RowCount2, 12) = MyDate
270 Next RowCount2

280 OldDate = NewDate
290 OldRow = RowCount
300 End If
310 End If
320 End If

330 Next RowCount

End Sub

The main problem I think was your use of IsEmpty. This is a test for
un-initialized (variant) variables and
I don't think you can use that on worksheet cells.
The other think I don't trust is doing Cells(RowCount, "L").
I think this should be Cells(RowCount2, 12) etc., but I might be wrong
there. It definitely looks a lot better/clearer.


RBS

 

[Jim Berglund]

Yes, Bart, you did it!
I never would have figured out the solution you provided (but may have a
better chance in the future)

Thank you SO MUCH!
Jim Berglund