How do I shorten and optimize this code


Posted by Steve on January 21, 2001 12:03 PM

I have written this piece of code to calculate the time taken to do a particular job based on a cell entry in the form of 900-930 or 1015-100 etc. These are the timein-timeout values keyed into the cell in column 6 of that row on the sheet. The total time taken (in minutes) is then placed into the cell in column 23 of that row on the sheet. My question is this: Is there an easier way to do this or a more optimized way for execution speed?

---snip
If Cells(Row, 6) <> "" And IsNumeric(Left(Cells(Row, 6), 2)) Then
Dim tintout As Long
Dim inhour As Long
Dim inmin As Long
Dim outhout As Long
Dim outmin As Long
Dim lentio As Long
Dim tin As Long
Dim tout As Long
mycell = Cells(Row, 6)
hyphen = InStr(mycell, "-")
lentio = Len(Cells(Row, 6))
If lentio = 7 And hyphen = 4 Then
inhour = Left(mycell, 1) * 60
inmin = Mid(mycell, 2, 2)
outhour = Mid(mycell, 5, 1) * 60
outmin = Right(mycell, 2)
End If
If lentio = "8" And hyphen = "4" Then
inhour = Left(mycell, 1) * 60
inmin = Mid(mycell, 2, 2)
outhour = Mid(mycell, 5, 2) * 60
outmin = Right(mycell, 2)
End If
If lentio = "8" And hyphen = "5" Then
inhour = Left(mycell, 2) * 60
inmin = Mid(mycell, 3, 2)
outhour = Mid(mycell, 6, 1) * 60
outmin = Right(mycell, 2)
End If
If lentio = "9" And hyphen = "5" Then
inhour = Left(mycell, 2) * 60
inmin = Mid(mycell, 3, 2)
outhour = Mid(mycell, 6, 2) * 60
outmin = Right(mycell, 2)
End If
tin = inhour + inmin
tout = outhour + outmin
If tout < tin Then
tout = tout + 720
End If
Cells(Row, 23) = tout - tin
Else
Cells(Row, 23) = ""
End If
---snip



Posted by cpod on January 22, 2001 11:14 AM


You can try this. It's shorter. I'd don't know how much faster it will be:

Dim tintout As String
Dim inhour As Integer
Dim inmin As Long
Dim outhour As Integer
Dim outmin As Long
Dim lentio As Long
Dim tin As Long
Dim tout As Long
Dim intCnt As Integer
intCnt = 1
Do Until ActiveSheet.Cells(intCnt, 1) = 0
tintout = ActiveSheet.Cells(intCnt, 1)
tin = Left(tintout, InStr(tintout, "-") - 1)
tout = Mid(tintout, InStr(tintout, "-") + 1, 10)
If tin > tout Then tout = tout + 1200
inhour = WorksheetFunction.RoundDown(tin, -2)
outhour = WorksheetFunction.RoundDown(tout, -2)
inmin = tin - inhour
outmin = tout - outhour
ActiveSheet.Cells(intCnt, 2) = (outhour - inhour - 100) / 100 * 60 + (60 - inmin) + outmin
intCnt = intCnt + 1
Loop