Generating formula for summing time / date values.

[EirikDaude]

I have a workbook, in which a row basically looks like this:

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

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