Home > Software engineering >  Excel VBA script crashing for unknown reason
Excel VBA script crashing for unknown reason

Time:11-06

I cannot believe I can't figure this out. It seems so stupid. I have a user form that has a few fields and when I press the submit button it updates the spreadsheet and tracks everything each day. The issue is that when it tries to update the sheet the first line of code executes and then the sub ends for some reason. I appreciate the help! here is my code

    Private Sub cmdSubmit_Click()
    Dim x As Integer
x = 1
Do  'find date
   If Trim(Worksheets("Personal").Range("A1").Offset(x).Value) = txtdate.Value Then GoTo Found
   x = x   1
Loop Until Worksheets("Personal").Range("A1").Offset(x).Value = ""
MsgBox ("Date not found")
Exit Sub
Found:
    Worksheets("Personal").Range("A1").Offset(x, 1).Value = txtweight.Value 'code fail point
    Worksheets("Personal").Range("A1").Offset(x, 2).Value = Worksheets("Personal").Range("A1").Offset(x, 2).Value   txtpush.Value
    If CBWalk.Value = True Then
        Worksheets("Personal").Range("A1").Offset(x, 3).Value = "x"
    Else
        Worksheets("Personal").Range("A1").Offset(x, 3).Value = ""
    End If

Unload Me
End Sub

I have looked over the sheet settings and singled out every line of code but cannot find the cause. If I comment out the line with the issue then the following line that updates the spreadsheet causes the same issue.

CodePudding user response:

The solution that I figured out was to take each field in the form and move them to a variable, then I passed those into another sub in a different module. Seems like once it was completely disconnected from the original form there was no issue with the update. still don't really understand why it was doing it in the first place...

CodePudding user response:

No need to iterate the rows, use Range.Find

Option Explicit

Private Sub cmdSubmit_Click()

    Dim lastrow As Long, r As Long, ws As Worksheet
    Dim dt As Date, cell As Range
    
    ' first validate date
    If Not IsDate(TxtDate.Value) Then
        MsgBox "'" & TxtDate.Value & "' is not a valid date", vbCritical
        Exit Sub
    End If

    Set ws = Worksheets("Personal")
    With ws
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
         ' search for date
        dt = DateValue(TxtDate.Value)
        Set cell = .Range("A1:A" & lastrow).Find(dt, LookIn:=xlFormulas, lookat:=xlWhole)
     
        If cell Is Nothing Then
            MsgBox Format(dt, "yyyy-mm-dd") & " not found", vbExclamation
        Else
            cell.Offset(0, 1).Value = txtweight.Value
            cell.Offset(0, 2).Value = cell.Offset(0, 2).Value   txtpush.Value
            cell.Offset(0, 3).Value = IIf(CBwalk.Value, "x", "")
        End If
    End With
    Unload Me
    
End Sub
  • Related