Delete Cell Contents when macro runs

**brown3218** · 09-05-2013, 06:43 PM

Below is my current code that is working fine. The Macro runs when I type a value into cell G2, it then adds the value of G2 to cell G4, G5, G6, G7, or G8 depending on the date. What code can I add to this so that once the macro adds G2 to the other cell, it would then delete the contents of cell G2?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim nRw As Long, rCell As Range
Set rCell = Range("A1")

        'My CODE FOR G ________________________________________________
If Target.Address = "$G$2" Then
                       
            If rCell.Value = "" Then
                MsgBox "No Value Found", vbInformation, "Input Required"
                Exit Sub
            End If
            
            On Error GoTo NoMatchFound:
            nRw = Range("A:A").Find(rCell.Value).Row
            
            With Cells(nRw, "G")
                .Value = .Value + Range("G2").Value
            End With
        Exit Sub

                'My CODE FOR H ________________________________________________
ElseIf Target.Address = "$H$2" Then
                                       
                    If rCell.Value = "" Then
                        MsgBox "No Value Found", vbInformation, "Input Required"
                        Exit Sub
                    End If
                    
                    On Error GoTo NoMatchFound:
                    nRw = Range("A:A").Find(rCell.Value).Row
                    
                    With Cells(nRw, "H")
                        .Value = .Value + Range("H2").Value
                    End With
                    
                    Exit Sub
                    
                      'My CODE FOR I ________________________________________________
ElseIf Target.Address = "$I$2" Then
                                       
                    If rCell.Value = "" Then
                        MsgBox "No Value Found", vbInformation, "Input Required"
                        Exit Sub
                    End If
                    
                    On Error GoTo NoMatchFound:
                    nRw = Range("A:A").Find(rCell.Value).Row
                    
                    With Cells(nRw, "I")
                        .Value = .Value + Range("I2").Value
                    End With
                    
                    Exit Sub
NoMatchFound:
                        MsgBox "No Match Found", vbCritical, "Task Un-Successfull"
End If


End Sub

**Solus Rankin** · 09-05-2013, 07:02 PM

Maybe

Private Sub Worksheet_Change(ByVal Target As Range)


Dim nRw As Long, rCell As Range
Set rCell = Range("A1")

Application.EnableEvents = False

        'My CODE FOR G ________________________________________________
If Target.Address = "$G$2" Then

            Application.EnableEvents = False
                       
            If rCell.Value = "" Then
                MsgBox "No Value Found", vbInformation, "Input Required"
                Exit Sub
            End If
            
            On Error GoTo NoMatchFound:
            nRw = Range("A:A").Find(rCell.Value).Row
            
            With Cells(nRw, "G")
                .Value = .Value + Range("G2").Value
            End With
            Range("G2").ClearContents
            Application.EnableEvents = True
        Exit Sub

                'My CODE FOR H ________________________________________________
ElseIf Target.Address = "$H$2" Then
                                       
                    If rCell.Value = "" Then
                        MsgBox "No Value Found", vbInformation, "Input Required"
                        Exit Sub
                    End If
                    
                    On Error GoTo NoMatchFound:
                    nRw = Range("A:A").Find(rCell.Value).Row
                    
                    With Cells(nRw, "H")
                        .Value = .Value + Range("H2").Value
                    End With
                    
                    Exit Sub
                    
                      'My CODE FOR I ________________________________________________
ElseIf Target.Address = "$I$2" Then
                                       
                    If rCell.Value = "" Then
                        MsgBox "No Value Found", vbInformation, "Input Required"
                        Exit Sub
                    End If
                    
                    On Error GoTo NoMatchFound:
                    nRw = Range("A:A").Find(rCell.Value).Row
                    
                    With Cells(nRw, "I")
                        .Value = .Value + Range("I2").Value
                    End With
                    
                    Exit Sub
NoMatchFound:
                        MsgBox "No Match Found", vbCritical, "Task Un-Successfull"
End If


End Sub

**Richard Buttrey** · 09-05-2013, 07:08 PM

perhaps

Application.EnableEvents = False

With Cells(nRw, "G")
   .Value = .Value + Range("G2").Value
   Target.Delete
End With

Application.EnableEvents = True

**brown3218** · 09-05-2013, 07:17 PM

Not quite sure how to insert that into my code.

Originally Posted by Richard Buttrey

perhaps

Application.EnableEvents = False

With Cells(nRw, "G")
   .Value = .Value + Range("G2").Value
   Target.Delete
End With

Application.EnableEvents = True

**Solus Rankin** · 09-06-2013, 09:27 AM

Brown,

If you don't hear from Richard try the code in post #2. I amended and included your entire code.

**brown3218** · 09-06-2013, 04:06 PM

Thanks Solus,

I tried your code and it worked once and then it the whole macro stopped working. I didn't get any errors, it just stopped adding the cell value to the other.

**Solus Rankin** · 09-07-2013, 02:10 PM

I may have disabled events too soon because of the exit sub. Try

Private Sub Worksheet_Change(ByVal Target As Range)


Dim nRw As Long, rCell As Range
Set rCell = Range("A1")

Application.EnableEvents = False

        'My CODE FOR G ________________________________________________
If Target.Address = "$G$2" 
                       
            If rCell.Value = "" Then
                MsgBox "No Value Found", vbInformation, "Input Required"
                Exit Sub
            End If
            
            On Error GoTo NoMatchFound:
            nRw = Range("A:A").Find(rCell.Value).Row
            
            With Cells(nRw, "G")
            application.enableevents = false
                .Value = .Value + Range("G2").Value
            End With
            Range("G2").ClearContents
            Application.EnableEvents = True
        Exit Sub

                'My CODE FOR H ________________________________________________
ElseIf Target.Address = "$H$2" Then
                                       
                    If rCell.Value = "" Then
                        MsgBox "No Value Found", vbInformation, "Input Required"
                        Exit Sub
                    End If

**brown3218** · 09-07-2013, 03:48 PM

Hmm, when I run this it gives me a syntax error and highlights If Target.Address = "$G$2"

Originally Posted by Solus Rankin

I may have disabled events too soon because of the exit sub. Try

Private Sub Worksheet_Change(ByVal Target As Range)


Dim nRw As Long, rCell As Range
Set rCell = Range("A1")

Application.EnableEvents = False

        'My CODE FOR G ________________________________________________
If Target.Address = "$G$2" 
                       
            If rCell.Value = "" Then
                MsgBox "No Value Found", vbInformation, "Input Required"
                Exit Sub
            End If
            
            On Error GoTo NoMatchFound:
            nRw = Range("A:A").Find(rCell.Value).Row
            
            With Cells(nRw, "G")
            application.enableevents = false
                .Value = .Value + Range("G2").Value
            End With
            Range("G2").ClearContents
            Application.EnableEvents = True
        Exit Sub

                'My CODE FOR H ________________________________________________
ElseIf Target.Address = "$H$2" Then
                                       
                    If rCell.Value = "" Then
                        MsgBox "No Value Found", vbInformation, "Input Required"
                        Exit Sub
                    End If

**Solus Rankin** · 09-09-2013, 09:43 AM

This changes things up a bit, but I believe its what you're trying to achieve

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rCell As Range
Dim bCheck As Boolean

        'My CODE FOR G ________________________________________________
If Not Intersect(Target, Range("G2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("G" & rCell.Row)
                    .Value = .Value + Range("G2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("G2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If


                'My CODE FOR H ________________________________________________
ElseIf Not Intersect(Target, Range("H2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("H" & rCell.Row)
                    .Value = .Value + Range("H2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("H2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
                    
                      'My CODE FOR I ________________________________________________
ElseIf Not Intersect(Target, Range("I2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("I" & rCell.Row)
                    .Value = .Value + Range("I2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("I2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If
If bCheck = False Then
    MsgBox "No Match Found", vbCritical, "Task Un-Successfull"
End If

End Sub

**brown3218** · 09-09-2013, 01:00 PM

Sorry for all of the back and forth. I now get an error, "Compile Error: Else Without If". It Highlights this line: ElseIf Not Intersect(Target, Range("H2")) Is Nothing Then

Originally Posted by Solus Rankin

This changes things up a bit, but I believe its what you're trying to achieve

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rCell As Range
Dim bCheck As Boolean

        'My CODE FOR G ________________________________________________
If Not Intersect(Target, Range("G2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("G" & rCell.Row)
                    .Value = .Value + Range("G2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("G2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If


                'My CODE FOR H ________________________________________________
ElseIf Not Intersect(Target, Range("H2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("H" & rCell.Row)
                    .Value = .Value + Range("H2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("H2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
                    
                      'My CODE FOR I ________________________________________________
ElseIf Not Intersect(Target, Range("I2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("I" & rCell.Row)
                    .Value = .Value + Range("I2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("I2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If
If bCheck = False Then
    MsgBox "No Match Found", vbCritical, "Task Un-Successfull"
End If

End Sub

**Solus Rankin** · 09-09-2013, 02:34 PM

I missed an 'end if'

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rCell As Range
Dim bCheck As Boolean

        'My CODE FOR G ________________________________________________
If Not Intersect(Target, Range("G2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("G" & rCell.Row)
                    .Value = .Value + Range("G2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("G2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If


                'My CODE FOR H ________________________________________________
ElseIf Not Intersect(Target, Range("H2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("H" & rCell.Row)
                    .Value = .Value + Range("H2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("H2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If
                    
                      'My CODE FOR I ________________________________________________
ElseIf Not Intersect(Target, Range("I2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("I" & rCell.Row)
                    .Value = .Value + Range("I2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("I2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If
If bCheck = False Then
    MsgBox "No Match Found", vbCritical, "Task Un-Successfull"
End If

End Sub

**brown3218** · 09-09-2013, 11:23 PM

Thank you thank you!

**brown3218** · 09-09-2013, 11:24 PM

Ended up using this:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rCell As Range
Dim bCheck As Boolean

        'My CODE FOR G ________________________________________________
If Not Intersect(Target, Range("G2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("G" & rCell.Row)
                    .Value = .Value + Range("G2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("G2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If


                'My CODE FOR G ________________________________________________
If Not Intersect(Target, Range("H2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("H" & rCell.Row)
                    .Value = .Value + Range("H2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("H2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If

                    'My CODE FOR I ________________________________________________
If Not Intersect(Target, Range("I2")) Is Nothing Then
    bCheck = False
    If Not Range("A1").Value = "" Then
        For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If rCell.Value = Range("A1").Value Then
                With Range("I" & rCell.Row)
                    .Value = .Value + Range("I2").Value
                    bCheck = True
                    Application.EnableEvents = False
                    Range("I2").ClearContents
                    Application.EnableEvents = True
                End With
            End If
        Next rCell
    ElseIf Range("A1").Value = "" Then
        MsgBox "No Value Found", vbInformation, "Input Required"
    End If
End If


End Sub

Delete Cell Contents when macro runs

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Re: Delete Cell Contents when macro runs

Thread Information

Users Browsing this Thread

Similar Threads

Delete Cell Value after Macro Runs

[SOLVED] Macro to delete certain contents of a cell

Macro to delete entire row based on cell contents

Macro to delete cell contents in every other column

[SOLVED] VBA Excel Macro to delete contents in named cell

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions