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?
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: