VBA to calculate and conditional format cell

[johnny70]

Currently using a direct formula in the excel sheet: B10=A10-A9 to get the cycle time between the two units

How do use Vba code for this so that each time a press the button the sub created also does this calculation?
Would also like it to conditional format the Cell ( in the example B10) so that the text is highlighted bold in red if value is larger then set time, Cell C2
Current code for click function looks like this
Public countunit As Integer

Public koll As Integer


Private Sub Click()
' function to secure continuing from last used cell if document is closed and repopened
Dim lRow As Long
lRow = Sheets("User Data").Cells(Rows.Count, "A").End(xlUp).Row
If lRow >= 8 Then
koll = 1
countunit = lRow + 1
End If
'click function and stepping to next cell
If koll = 1 Then
Worksheets("User Data").Protect Contents:=False
Worksheets("User Data").Cells(countunit, 1) = Format(Now, "mm/dd/yyyy HH:mm:ss")
countunit = countunit + 1
koll = 1

Cells(2, 4) = "Antal enheter"
Cells(3, 4) = countunit - 9

End If

Worksheets("User Data").Protect Contents:=True

End Sub

 

[rollis13]

Is this what you meant? Please note that I didn't use CF, I just formatted the cell in column B if greater than C2:

Public countunit As Integer
Public koll   As Integer
Private Sub Click()
    'function to secure continuing from last used cell if document is closed and reopened
    Dim lRow  As Long
    lRow = Sheets("User Data").Cells(Rows.Count, "A").End(xlUp).Row
    If lRow >= 8 Then
        koll = 1
        countunit = lRow + 1
    End If
    'click function and stepping to next cell
    If koll = 1 Then
        With Worksheets("User Data")
            .Protect Contents:=False
            .Cells(countunit, 1) = Format(Now, "mm/dd/yyyy HH:mm:ss")
            If countunit = 9 Then
                .Cells(countunit, 2) = "0:00"     'first line time (no formula)
            Else
                .Cells(countunit, 2).FormulaR1C1 = "=RC[-1]-R[-1]C[-1]" 'add formula
                .Cells(countunit, 2).NumberFormat = "h:mm;@" 'format time
                If .Cells(countunit, 2) > .Cells(2, "C") Then 'if greater than C2
                    .Cells(countunit, 2).Interior.ColorIndex = 3 'add color
                    .Cells(countunit, 2).Font.Bold = True 'add bold
                End If
            End If
        End With
        countunit = countunit + 1
        koll = 1
        Cells(2, 4) = "Antal enheter"
        Cells(3, 4) = countunit - 9
    End If
    Worksheets("User Data").Protect Contents:=True
End Sub

 

[johnny70]

Overall is seems to be working, comparing and marking if greater than set cycle time but the time format is not correct, Im not familiar to the code used NumberFormat "h:mm;@" , is it just to change to "hh:mm:ss;@" or "mm:ss;@"?

Should show 11 minutes and 7 sec
2024-03-17 08:40:26
2024-03-17 08:51:33

 

[rollis13]

Yes, for the minutes and seconds in column B it would be "m:ss;@". You can use the Macro Recorder to have Excel create code snippets as suggestions.
I'm assuming the negative time I see in your last screenshot at line 11 is just due to testing, so it's not a problem.

 

[johnny70]

Yes, for the minutes and seconds in column B it would be "m:ss;@". You can use the Macro Recorder to have Excel create code snippets as suggestions.
I'm assuming the negative time I see in your last screenshot at line 11 is just due to testing, so it's not a problem.

Negative time was due to my calculation formula if second time was higher than cycle time in calculation the time went negative. But with your solution it is corrected and the formatting highlight if larger than set cycle time.

 

[johnny70]

Last issue is that if I want to reset the sheet, e.g. new test or so.
I have started with this code:
Private Sub Reset_Click()
countunit = 9
koll = 1
Worksheets("User Data").Protect Contents:=False
Worksheets("Background Data").Protect Contents:=False

Worksheets("User Data").Cells(8, 1) = "Tidpunkt för enhet till station"


Worksheets("User Data").Cells(3, 4) = 0
Worksheets("User Data").Range("A9:A800").ClearContents
Worksheets("User Data").Range("B9:B800").ClearContents
Worksheets("User Data").Range("B9:B800").FormatConditions.Delete
Worksheets("User Data").Range("C9:C800").ClearContents

'Worksheets("Data").Cells.ClearContents

Worksheets("User Data").Cells(8, 1) = "Tidpunkt för enhet till station"
Worksheets("User Data").Cells(2, 4) = "Antal Enheter"
'Worksheets("User Data").Cells(9, 1) = 0
Worksheets("Background Data").Cells(2, 6) = "Värde för radräknare"
Worksheets("Background Data").Cells(3, 6) = countunit
Worksheets("Background Data").Cells(4, 6) = "Uppdaterad"
Worksheets("Background Data").Cells(4, 6) = Format(Now, "mm/dd/yyyy HH:mm:ss")


Worksheets("User Data").Protect Contents:=True
Worksheets("Background Data").Protect Contents:=True

End Sub
Bur it still keep the formatting in cell that has been highlighted:

Not sure if this should be another tread or if Im allowed to place it in same

 

[rollis13]

With some tweaks this should do the job:

Private Sub Reset_Click()
    countunit = 9
    koll = 1
    With Worksheets("User Data")
        .Protect Contents:=False
        .Cells(8, 1) = "Tidpunkt för enhet till station"
        .Cells(2, 4) = "Antal Enheter"
        .Cells(3, 4) = 0
        .Range("A9:C800").ClearContents
        .Range("B9:B800").FormatConditions.Delete
        .Range("B9:B800").Interior.ColorIndex = xlNone
        .Protect Contents:=True
    End With
    With Worksheets("Background Data")
        .Protect Contents:=False
        .Cells(2, 6) = "Värde för radräknare"
        .Cells(3, 6) = countunit
        .Cells(4, 6) = "Uppdaterad"
        .Cells(5, 6) = Format(Now, "mm/dd/yyyy HH:mm:ss")
        .Protect Contents:=True
    End With
End Sub