最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

Recording time it takes to complete a row in Excel using VBA - Stack Overflow

programmeradmin1浏览0评论

I would like to record a time it takes to finish filling out a form in Excel. I have created a form, where I have following columns;

start, col1, col2 ..., col8, end, time 

I would like the timer to start when someone enters 1 in start column and finish recording when someone enters 1 in end column, time should appear in column time.

I have written the following VBA code based on tutorials online, but it doesn't work (nothing happens when I enter 1 to first column first row (start) and then 1 to first row of last column (finish), the column time remains empty). How should the code be adjusted to do what I need it to do?

Dim StartTimes As Object ' Dictionary to store start times

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("form") 
    
    Dim StartCol As Integer: StartCol = 1        ' "start" column
    Dim FinishCol As Integer: FinishCol = 10     ' "finish" column
    Dim TimeCol As Integer: TimeCol = 11         ' "time" column

    If StartTimes Is Nothing Then Set StartTimes = CreateObject("Scripting.Dictionary")

    If Not Intersect(Target, ws.Columns(StartCol)) Is Nothing Then
        If Target.Value = 1 Then
            StartTimes(Target.Row) = Now ' Store current timestamp
        End If
    End If

    If Not Intersect(Target, ws.Columns(FinishCol)) Is Nothing Then
        If Target.Value = 1 Then
            If StartTimes.Exists(Target.Row) Then
                ' Calculate elapsed time
                Dim StartTime As Date
                StartTime = StartTimes(Target.Row)
                ws.Cells(Target.Row, TimeCol).Value = Format(Now - StartTime, "hh:mm:ss")
                StartTimes.Remove Target.Row 
            End If
        End If
    End If
End Sub

I would like to record a time it takes to finish filling out a form in Excel. I have created a form, where I have following columns;

start, col1, col2 ..., col8, end, time 

I would like the timer to start when someone enters 1 in start column and finish recording when someone enters 1 in end column, time should appear in column time.

I have written the following VBA code based on tutorials online, but it doesn't work (nothing happens when I enter 1 to first column first row (start) and then 1 to first row of last column (finish), the column time remains empty). How should the code be adjusted to do what I need it to do?

Dim StartTimes As Object ' Dictionary to store start times

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("form") 
    
    Dim StartCol As Integer: StartCol = 1        ' "start" column
    Dim FinishCol As Integer: FinishCol = 10     ' "finish" column
    Dim TimeCol As Integer: TimeCol = 11         ' "time" column

    If StartTimes Is Nothing Then Set StartTimes = CreateObject("Scripting.Dictionary")

    If Not Intersect(Target, ws.Columns(StartCol)) Is Nothing Then
        If Target.Value = 1 Then
            StartTimes(Target.Row) = Now ' Store current timestamp
        End If
    End If

    If Not Intersect(Target, ws.Columns(FinishCol)) Is Nothing Then
        If Target.Value = 1 Then
            If StartTimes.Exists(Target.Row) Then
                ' Calculate elapsed time
                Dim StartTime As Date
                StartTime = StartTimes(Target.Row)
                ws.Cells(Target.Row, TimeCol).Value = Format(Now - StartTime, "hh:mm:ss")
                StartTimes.Remove Target.Row 
            End If
        End If
    End If
End Sub
Share Improve this question edited Mar 31 at 5:48 marc_s 756k184 gold badges1.4k silver badges1.5k bronze badges asked Mar 30 at 21:58 1muflon11muflon1 2312 silver badges8 bronze badges 4
  • but it doesn't work provides no useful information ... please edit your post ... describe what actually happens – jsotola Commented Mar 30 at 22:59
  • @jsotola thanks for feedback, I tried to update my question, although the problem is that that pretty much I get no response from excel when I try to fill it out – 1muflon1 Commented Mar 30 at 23:19
  • 1 It seems like this code (with a ws change event) belongs in the worksheet with the form (the "form" sheet). You don't need to set ws references - worksheet code always go with the sheet its in. That's always seemed preferable to me, rather than dealing with sheet events at the workbook level. – topsail Commented Mar 30 at 23:19
  • You can learn a lot with some basic debugging: programming-excel-vba-debugging – topsail Commented Mar 30 at 23:20
Add a comment  | 

1 Answer 1

Reset to default 3

Your code is fine, just make sure it's directly in the Worksheet object, not in the spreadsheet Module:

I've updated your code slightly:

Option Explicit

Dim dictStartTimes As Object

Private Sub Worksheet_Change(ByVal rngTarget As Range)
    Dim wsForm As Worksheet
    Dim lngStartCol As Long
    Dim lngFinishCol As Long
    Dim lngTimeCol As Long
    Dim dtmStartTime As Date

    Set wsForm = ThisWorkbook.Sheets("form")
    lngStartCol = 1
    lngFinishCol = 10
    lngTimeCol = 11

    If dictStartTimes Is Nothing Then Set dictStartTimes = CreateObject("Scripting.Dictionary")

    On Error GoTo ErrorHandler

    If Not Intersect(rngTarget, wsForm.Columns(lngStartCol)) Is Nothing Then
        If rngTarget.Value = 1 Then
            dictStartTimes(rngTarget.Row) = Now
        End If
    End If

    If Not Intersect(rngTarget, wsForm.Columns(lngFinishCol)) Is Nothing Then
        If rngTarget.Value = 1 Then
            If dictStartTimes.Exists(rngTarget.Row) Then
                dtmStartTime = dictStartTimes(rngTarget.Row)
                wsForm.Cells(rngTarget.Row, lngTimeCol).Value = Format(Now - dtmStartTime, "hh:mm:ss")
                dictStartTimes.Remove rngTarget.Row
            End If
        End If
    End If

Cleanup:
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description
    Resume Cleanup
End Sub
发布评论

评论列表(0)

  1. 暂无评论