Generating formula for summing time / date values.

[EirikDaude]

I have a workbook, in which a row basically looks like this:
http://i.imgur.com/lRCCYny.png
Now, I want to insert formulas into column G which calculates the something similar to the following:

=if(isblank(J1);"";(I1+J1)-(A1+B1))
Simple enough so far. The problem is that columns B and J sometimes will contain dates in addition to the time values, and I suspect that it'd be possible for a user to input time values in columns A and I as well. So is there any way to extract just time / date value from the different columns and use those in the formula?

And what is the best way to generate the formula when I want it to be created when a value is put into the corresponding row in column E? Getting the event to fire when that is done isn't a problem, but getting the cell-names / addresses is a bit of a pain? Any simple way to do this?

[p45cal]

The date portion of a date and time value can be obtained with:
INT(A1)
The time portion of a date and time value can be obtained with:
MOD(A1,1)
So
=If(isblank(J1);"";(I1+J1)-(A1+B1))
might become:
=If(isblank(J1);"";(int(I1)+mod(J1,1))-(int(A1)+mod(B1,1)))
(I think!)

[EirikDaude]

Thanks! I was starting to think it would make more sense to simply sanitize the input of the user when those cells were changed, but your approach seems like it would work really well!

Now if to generate that formula in VBA, when column E is changed. Is there any simpler way to do that than what I've outlined below:

Dim f as String

If Target.CountLarge = 1 Then
If Intersect(Sheet1.Columns(5), Target) Then
f = "=ISBLANK(" & Target.Offset(0, 4).AddressLocal & ")," & """ & """ & ",(INT" & Target.Offset(0, 4).AddressLocal & ") + MOD(" & Target.Offset(0, 5).AddressLocal etc.

Target.Offset(0, 2).Formula = f
End If
End If
Cause getting the formula correct is going to be something of a pain, and very hard to read for whoever comes after me. Dunno... I have something of a start at least, even if I won't know if it works till I get to work tomorrow :D

Again, thanks for all your help so far.

[p45cal]

This one works (I think - check the formula is correct) if put in the sheet's own code-module (the unqualified Columns(5) will be that sheet's column 5):
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = 1 Then
If Not Intersect(Columns(5), Target) Is Nothing Then
Target.Offset(0, 2).FormulaR1C1 = "=IF(ISBLANK(RC10),"""",(INT(RC9)+MOD(RC10,1))-(INT(RC1)+MOD(RC2,1)))"
End If
End If
End Sub

[EirikDaude]

Thanks again, that is a lot simpler!

I haven't really used the RC-notation much before, it seems I should start looking into it :)

[p45cal]

I haven't really used the RC-notation much before, it seems I should start looking into it :)It's what appears in the code if you record your entering the formula in the cell. The main advantage in this case is that all the formulae in column G are exactly the same in R1C1 notation. Try it by going into Options|Formulas|R1C1 reference Style and looking at the formulae in column G.

[EirikDaude]

I got it to work, thanks a ton!

(Did I already say that?)

And yeah, I got the rough idea of how it'd work from the first example you posted :) It really is a rather neat way to reference cells in the code.

[snb]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
if Target.column=5 Then Target.Offset(, 2) = iif(target.offset(,5)=[/FONT]"","",(int(target.offset(,4))+target.offset(,5) mod 1)-(INT(target.offset(,-4))+target.offset(,-4) mod 1) )
End If
End Sub

[EirikDaude]

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

' Ingen ark bortsett frå dette skal ha valideringslister
If Sh.Name = "Registrering" Then
Call deaktiver
Else
Exit Sub
End If

' Ikkje lag lister om det oppstår ein feil (f.eks. om Target.Count er veldig stor)
On Error GoTo errorHandler:
If Target.Count > 1 Then
Call reaktiver
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0

' Om det er overskriftskolonna som vert vald skal det heller ikkje lagast lister.
If Target.Row = 1 Then
Call reaktiver
Exit Sub
End If

' Sjekk om det vert registrert riktig!
Select Case Target.Column
Case 1, 9:
If Not Target = "" Then
Call rediger_ark(Sh)
Target = CLng(Target)
Target.NumberFormat = "dd. mmm"
Call lås_ark(Sh)
End If
Case 2, 10:
If Not Target = "" Then
Call rediger_ark(Sh)
Target.NumberFormat = "HH:mm"
Call lås_ark(Sh)
End If
Case 3:
Call hovudlister(Target)
Case 5:
Call detaljertelister(Range(Target.Address(external:=True)))
Case Else:
MsgBox ("Noko gjekk gale i ThisWorkbook når celle " & Target.Address(external:=True) & " vart endra.")
End Select

Call reaktiver

Exit Sub

errorHandler:
If Err.Number = 6 Then
Debug.Print ("Overflow error!")
Call reaktiver
On Error GoTo 0
Exit Sub
Else
Debug.Print ("Feil nummer " + Err.Number + ". Beskrivelse: " + Err.Description + ". Skjøner ikkje korleis me hamna her!")
Resume
End If
End Sub

Sub detaljertelister(endraCelle As Range)
Dim listaStarterICelle As Range, overskrifter As Range

Call rediger_ark(registrering)

' Finn verdien frå cella, ventar med offset i tilfelle nothing.
Set listaStarterICelle = Detaljlister.Rows(1).Find(endraCelle.Offset(0, -2).Value, LookIn:=xlValues, MatchCase:=False)
' Feilsjekk
If listaStarterICelle Is Nothing Then
MsgBox ("Noko gjekk gale - få nokon til å sjå på kva endringar som er gjort i arket i det siste.")
Exit Sub
Else
' Overskrifter = moglege verdiar for den valde utstyrsgruppa.
Set overskrifter = Range(listaStarterICelle, listaStarterICelle.End(xlToRight).Offset(0, -1)).Offset(1, 0)
Debug.Print (overskrifter.Address(external:=True))
End If

Set listaStarterICelle = overskrifter.Find(endraCelle.Value, LookIn:=xlValues, MatchCase:=False)
' Feilsjekk
If listaStarterICelle Is Nothing Then
MsgBox ("Noko gjekk gale - få nokon til å sjå på kva endringar som er gjort i arket i det siste.")
Exit Sub
End If

Set listaStarterICelle = listaStarterICelle.Offset(1, 0)

' Ny validering for detaljårsaker, tid og skift
With endraCelle
Range(.Offset(0, 1), .Offset(0, 5)).Validation.Delete
' Oppdater validering for kolonne F (detaljårsaker)
.Offset(0, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=("=" + lagListe(listaStarterICelle).Address(external:=True))
' Oppdater formel for kolonne E (stanstid)
If IsEmpty(.Offset(0, 2)) Then
.Offset(0, 2).FormulaR1C1 = "=IF(ISBLANK(RC10)," & Chr(34) & Chr(34) & ",ROUND(((INT(RC9)+MOD(RC10,1))-(INT(RC1)+MOD(RC2,1)))*24,0))" ' <------------ HERE'S WHERE THE FORMULA IS GENERATED
End If
With .Offset(0, 3).Validation
.Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1", Formula2:="5"
.ErrorMessage = "Verdien i denne kolonna må vere eit heiltal mellom 1 og 5."
.ErrorTitle = "Feil i inndata."
.InputMessage = "Skriv inn kva skift som var på då stansen skjedde."
.InputTitle = "Skift."
End With
' Lås opp alt bortsett frå kolonne E
.Offset(0, 1).Locked = False
Range(.Offset(0, 3), .Offset(0, 5)).Locked = False
End With
' Dato i kolonne I
With endraCelle.Offset(0, 4).Validation
.Add Type:=xlValidateDate, AlertStyle:=xlValidAlertStop, Operator:=xlGreaterEqual, Formula1:="=" & endraCelle.Offset(0, -4).Address(external:=True)
.ErrorMessage = "Verdien i denne kolonna må vere ein dato større eller lik " & endraCelle.Offset(0, -4) & "!"
.ErrorTitle = "Feil i inndata."
.InputMessage = "Skriv inn datoen køyretøyet vart levert tilbake."
.InputTitle = "Dato."
End With
With endraCelle.Offset(0, 5).Validation
.Add Type:=xlValidateTime, AlertStyle:=xlValidAlertStop, Operator:=xlGreaterEqual, Formula1:="00:00"
.ErrorMessage = "Verdien i denne kolonna må vere eit tidspunkt, på forma" & Chr(34) & "TT:mm" & Chr(34) & "."
.ErrorTitle = "Feil i inndata."
.InputMessage = "Skriv inn kva tid køyretøyet vart levert tilbake."
.InputTitle = "Tid."
End With

Call lås_ark(registrering)

End Sub

I am sure there's an easier way to do it, but that's how the formula is generated in my workbook :P