Excel VBA - Delete Data from a Worksheet If Select

2019-03-04 19:21发布

问题:

Follow up question to a previously answered question: Excel VBA - Run a macro based on a range of dropdown lists.

Current: This is for a personal expense spreadsheet and I am using Column G on my Master worksheet to classify line item expenses imported from a .csv provided by my credit union. Each cell in Column G has a dropdown list which is the name of the other worksheets in my workbook: Power, Gas, Groceries, etc. Currently, when you make a selection from the Column G dropdown list, it copies A1:F1 of the current row and pastes it to the next empty row of whatever worksheet was selected, e.g. Power or Gas or Groceries. All of that is finally working fine.

Problem: However, if I re-classify a line expense, e.g. from my original selection Gas and I change it to Power it will again copy A1:F1 of the current row and move to the Power worksheet. That is great BUT I need it to remove the line we copied from our Gas tab.

Possible Solution?: The only way I can think of this is adding something like this... IF the dropdown is not blank and I change the original selection THEN I need to find an exact text copy of A1:F1 (A1: Date, B1: No., C1: Description, D1: Debit, E1: Credit, F1: Notes - these will ("should") never be duplicate) from the original selection worksheet (Gas) and delete those cells and move up the below rows. I'm asking for help for someone to please write that above scenario in code and show me what it will look like in my current code (I understand VBA at a novice level - at best).

Here is my current code that runs once a dropdown value is changed:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("G2:G1001"))
If Not rng Is Nothing Then
    For Each c In rng.Cells
        Select Case c.Value
            Case "Power": Power c
            Case "Gas": Gas c
            Case "Water": Water c
            Case "Groceries, etc.": GroceriesEtc c
            Case "Eating Out": EatingOut c
            Case "Amazon": Amazon c
            Case "Home": Home c
            Case "Entertainment": Entertainment c
            Case "Auto": Auto c
            Case "Medical": Medical c
            Case "Dental": Dental c
            Case "Income": Income c
            Case "Other": Other c
        End Select
    Next c
End If
End Sub

Here is the case macro that is fired off from the above code (there is a similar macro for each case):

Sub Gas(c As Range)

Dim rng As Range

Set rng = c.EntireRow.Range("A1:F1") '<< A1:F1 here is *relative to c.EntireRow*

'copy the values
With Worksheets("Gas").Cells(Rows.Count, 1).End(xlUp)
    .Offset(1, 0).Resize(1, rng.Cells.Count).Value = rng.Value
End With

End Sub

Any Suggestions?

回答1:

Try this. You probably need to tweak it a bit, but it should get you going. I have added a global variable that you can store the previous value from the dropdown list.
In the SelectionChange I have tried to create an error handling to take care of multiple cells selected. If just 1 cell selected then that value will be bound to the global variable. Then you can use that variable to find the sheet of the previous value in the dropdown list, loop through the sheet, and delete the value.

First I have added this to your Gas, Power, etc. subs. to make them dynamic.

Sub Power(c As Range)

    Dim rng As Range

    Set rng = Nothing
    Set rng = Range("A" & c.Row & ":F" & c.Row) '<< A1:F1 here is *relative to c.EntireRow*

    'copy the values
    With Worksheets("Power").Cells(Rows.Count, 1).End(xlUp)
        .Offset(1, 0).Resize(1, rng.Cells.Count).Value = rng.Value

        ' Copy formating from Master Sheet
        With Worksheets("Master")
            Range("A" & c.Row & ":F" & c.Row).Copy
        End With
        .Offset(1, 0).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False

    End With

End Sub

Under the Master sheet (not module), I have added this:

' Add this to the absolute top of the sheet, must be outside a procedure (sub)
Option Explicit
Public cbxOldVal As String
Dim PrevVal As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Rows.Count > 1 Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub

cbxOldVal = Target.Value
End Sub

Private Sub Worksheet_Activate()
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
End Sub

Add this to your Worksheet_Change event.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("G2:G1001"))

If Not Intersect(Target, Columns("G")) Is Nothing Then
    If PrevVal <> "" Or cbxOldVal <> "" Then
        If cbxOldVal = Target.Value Then
            MsgBox "You have to click on another cell " & vbNewLine & "and then click back on " & Target.Address & " to change the value", vbExclamation, "Error"
            Cells(Target.Row, Target.Column) = PrevVal
            Exit Sub
        ElseIf Target.Value = "" Or Target.Value = PrevVal Then Exit Sub
        End If
    End If
End If

If Not rng Is Nothing Then
' Your loop

Then I have added some code to your Worksheet_Change event. Add this to after the End Select.

    If cbxOldVal = "" Then
    ' do nothing

    Else

        With Worksheets(cbxOldVal)

            Dim i As Integer
            Dim strFindA As String, strFindB As String, strFindC As String
            Dim strFindD As String, strFindE As String, strFindF As String
            strFindA = Sheets("Master").Range("A" & c.Row)
            strFindB = Sheets("Master").Range("B" & c.Row)
            strFindC = Sheets("Master").Range("C" & c.Row)
            strFindD = Sheets("Master").Range("D" & c.Row)
            strFindE = Sheets("Master").Range("E" & c.Row)
            strFindF = Sheets("Master").Range("F" & c.Row)

            For i = 1 To 100    ' replace with lastrow

            If .Cells(i, 1).Value = strFindA _
            And .Cells(i, 2).Value = strFindB _
            And .Cells(i, 3).Value = strFindC _
            And .Cells(i, 4).Value = strFindD _
            And .Cells(i, 5).Value = strFindE _
            And .Cells(i, 6).Value = strFindF _
            Then

            .Rows(i).EntireRow.Delete
            MsgBox "deleted row " & i
            GoTo skip:

            End If

            Next i


        End With
    End If
skip: