Debug error

[hopr37]

My spreadsheet takes totals and subtracts totals.

I have about 6 columns and rows that are filled with data.
If I try to insert a new row I get a debug error.
The debug highlights "Application.Undo"
Not sure why
any suggestions?



Private Sub Worksheet_Change(ByVal Target As Range)
'copies the value of colum c into new cell as "old value"
Dim nextRow As Integer
Dim oldValues As Variant
Dim newValues As Variant
Dim oldRev, newRev, diffRev As Double
Dim NumRows, NumCols As Integer
Dim lRow, lCol As Integer
If Not Intersect(Target, Range("C:C")) Is Nothing Then
NumRows = Target.Cells.Rows.Count
NumCols = Target.Cells.Columns.Count
newValues = Target.Value2
Application.EnableEvents = False
Application.Undo
oldValues = Target.Value2
Target.Offset(0, 1).Value = Target.Value
Target = newValues
Application.EnableEvents = True
End If

 

[rlv01]

Try this code. You should be able to insert a row.

Private Sub Worksheet_Change(ByVal Target As Range)
'copies the value of colum c into new cell as "old value"
    Dim ColC_Data As Range
    Dim Msg As String
    Dim Ans As Integer

    If Target.Columns.Count > 1 Then
        Exit Sub    'likely row insert or delete operation
    End If

    Set ColC_Data = Range("C4", Range("C" & Rows.Count).End(xlUp))

    If Not Intersect(Target, ColC_Data) Is Nothing Then
        Msg = "Used footage: " & Target.Value & " ft." & vbCr
        Msg = Msg & "Remaining footage would be: " & Target.Offset(0, 2).Value - Target.Value & " ft." & vbCr & vbCr
        Msg = Msg & "Accept this change?"
        Ans = MsgBox(Msg, vbYesNo + vbDefaultButton1)
        Application.EnableEvents = False
        If Ans = vbYes Then
            Target.Offset(0, 1).Value = Target.Value    'set col D as old value
            If Target.Value > 0 Then
                Target.Offset(0, 2).Value = Target.Offset(0, 2).Value - Target.Value    'subtract col C value from existing col E as some kind of running total
            End If
        Else
            Target.Value = Target.Offset(0, 1).Value
        End If
        Application.EnableEvents = True
    End If

 

[hopr37]

That works!
Thank you for that!
My only concern is the messages. I may have 100 entries per day and having to click on the message box each time might get a little tedious.

 

[rlv01]

My only concern is the messages. I may have 100 entries per day and having to click on the message box each time might get a little tedious.

That's up to you. You can remove or comment out the message functionality

Private Sub Worksheet_Change(ByVal Target As Range)
'copies the value of colum c into new cell as "old value"
    Dim ColC_Data As Range
    Dim Msg As String
    Dim Ans As Integer

    If Target.Columns.Count > 1 Then
        Exit Sub    'likely row insert or delete operation
    End If

    Set ColC_Data = Range("C4", Range("C" & Rows.Count).End(xlUp))

    If Not Intersect(Target, ColC_Data) Is Nothing Then
        Msg = "Used footage: " & Target.Value & " ft." & vbCr
        Msg = Msg & "Remaining footage would be: " & Target.Offset(0, 2).Value - Target.Value & " ft." & vbCr & vbCr
        Msg = Msg & "Accept this change?"

       'Ans = MsgBox(Msg, vbYesNo + vbDefaultButton1)
        Ans = vbYes

        Application.EnableEvents = False
        If Ans = vbYes Then
            Target.Offset(0, 1).Value = Target.Value    'set col D as old value
            If Target.Value > 0 Then
                Target.Offset(0, 2).Value = Target.Offset(0, 2).Value - Target.Value    'subtract col C value from existing col E as some kind of running total
            End If
        Else
            Target.Value = Target.Offset(0, 1).Value
        End If
        Application.EnableEvents = True
    End If

 

[hopr37]

I tried blocking out the msg. portions but keep getting a new debug error.
Set WorkRng = Intersect(Application.ActiveSheet.Range("C:C"), Target)

From this section: ( it puts the date over by 3 rows)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetRow As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("C:C"), Target)
xOffsetRow = 3
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetRow).Value = Now
Rng.Offset(0, xOffsetRow).NumberFormat = "mm-dd-yyyy"
Else
Rng.Offset(0, xOffsetRow).ClearContents
End If
Next
Application.EnableEvents = True
End If

 

[rlv01]

This new section of code that you have posted above is a separate function (to date stamp the cell in column F). None of the code I posted earlier modified this part. The code I posted in #23 already has the msgbox portion disabled so as a test I took that #23 code and pasted it into your workbook on google drive keeping the code you posted above as-is. It works without any errors. Correctly populating all cells, including the date cells.

Private Sub Worksheet_Change(ByVal Target As Range)
'copies the value of colum c into new cell as "old value"
    Dim ColC_Data As Range
    Dim Msg As String
    Dim Ans As Integer

    If Target.Columns.Count > 1 Then
        Exit Sub    'likely row insert or delete operation
    End If

    Set ColC_Data = Range("C4", Range("C" & Rows.Count).End(xlUp))

    If Not Intersect(Target, ColC_Data) Is Nothing Then
        Msg = "Used footage: " & Target.Value & " ft." & vbCr
        Msg = Msg & "Remaining footage would be: " & Target.Offset(0, 2).Value - Target.Value & " ft." & vbCr & vbCr
        Msg = Msg & "Accept this change?"

        'Ans = MsgBox(Msg, vbYesNo + vbDefaultButton1)
        Ans = vbYes

        Application.EnableEvents = False
        If Ans = vbYes Then
            Target.Offset(0, 1).Value = Target.Value    'set col D as old value
            If Target.Value > 0 Then
                Target.Offset(0, 2).Value = Target.Offset(0, 2).Value - Target.Value    'subtract col C value from existing col E as some kind of running total
            End If
        Else
            Target.Value = Target.Offset(0, 1).Value
        End If
        Application.EnableEvents = True
    End If

    'adds date when column C enters data
    Dim WorkRng As Range
    Dim rng As Range
    Dim xOffsetRow As Integer
    Set WorkRng = Intersect(Application.ActiveSheet.Range("C:C"), Target)
    ' moves date over to 3rd row
    xOffsetRow = 3
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each rng In WorkRng
            If Not VBA.IsEmpty(rng.Value) Then
                rng.Offset(0, xOffsetRow).Value = Now
                rng.Offset(0, xOffsetRow).NumberFormat = "mm/dd/ hh:mm:ss"
            Else
                rng.Offset(0, xOffsetRow).ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If

    On Error Resume Next
    Application.ScreenUpdating = False

    If Not Intersect(Target, Range("C:C, A:A, F:F")) Is Nothing Then

        Dim r1, r2, r3 As Integer

        r1 = Application.WorksheetFunction.CountA(Sheets("CopperHistory").Range("B:B"))
        r2 = Application.WorksheetFunction.CountA(Sheets("CopperHistory").Range("C:C"))
        r3 = Application.WorksheetFunction.CountA(Sheets("CopperHistory").Range("D:D"))

        Sheets("CopperHistory").Range("B2").Offset(r1).Value = Sheets("Copper").Range("A" & Target.Row).Value
        Sheets("CopperHistory").Range("C2").Offset(r2).Value = Sheets("Copper").Range("C" & Target.Row).Value
        Sheets("CopperHistory").Range("D2").Offset(r3).Value = Sheets("Copper").Range("F" & Target.Row).Value
    End If

    Application.ScreenUpdating = True
    On Error GoTo 0
    'End Sub
End Sub

 

[hopr37]

I copied and pasted the above code and your right. I have no errors now. Thank you so much. Maybe I had some stray coding somewhere.