title: Copy Data a Worksheet If Selection from Dropdown List is Changed
body: <p>Follow up question to a previously answered question: <a href="https://stackoverflow.com/questions/40538259/excel-vba-delete-data-from-a-worksheet-if-selection-from-dropdown-list-is-chan">Excel VBA - Delete Data from a Worksheet If Selection from Dropdown List is Changed</a> </p>
  
  <p>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. </p>
  
  <p>Problem: </p>
  
  <p>While I was testing the answer from my previous question, it worked fine. However, there are now some new issues not that I have thousand of rows of real data</p>
  
  <p><strong>Issue #1:</strong> The copy and pasting of rows to other worksheets only works for the first few times I select a worksheet from the dropdown. For example, in cell G2, I select "Eating Out" from the dropdown, it will copy A1:F1 to the eating out worksheet. However, if if I go to G11 and select Amazon it won't do anything. It seems to work on the first 3 or 4 rows that I try to do but doesn't work on the rest. When I say it won't work, it just doesn't copy to any worksheet.</p>
  
  <p><strong>Issue #2:</strong> I ran into a never-ending message box error. When the error message pops-up and says,</p>
  
  <p>"You have to click on another cell " &amp; vbNewLine &amp; "and then click back on " &amp; Target.Address &amp; " to change the value""</p>
  
  <p>I click OK, and it just pops up again and won't let me do anything else. It just keeps popping up and the only way to get rid of the error message is to Force Quit Excel.</p>
  
  <p><strong>Issue #3:</strong> I sporadically ran into an copy/paste issue. What happens (only sometimes) is that it would copy column A,B,C,D,E,F and then paste column A from the master worksheet to column A in the selection worksheet, BUT column C from the master worksheet to column B in the selection worksheet, column D from the master worksheet to column C in the selection worksheet, column E from the master worksheet to column D in the selection worksheet and column F from the master worksheet to column E in the selection worksheet. I have no idea what happened to Column B from the master worksheet (my guess is since Column B from the master worksheet is always blank, it decided not to copy it over to the new worksheet?)?</p>
  
  <p>Here is my current code that runs once a dropdown value is changed:</p>
  
  <pre><code>Option Explicit
  Public cbxOldVal As String
  Dim PrevVal As Variant
  
  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Rows.Count &gt; 1 Then Exit Sub
  If Target.Columns.Count &gt; 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
  
  
  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range
  Set rng = Intersect(Target, Range("G2:G30000"))
  
  If Not Intersect(Target, Columns("G")) Is Nothing Then
      If PrevVal &lt;&gt; "" Or cbxOldVal &lt;&gt; "" Then
          If cbxOldVal = Target.Value Then
              MsgBox "You have to click on another cell " &amp; vbNewLine &amp; "and then click back on " &amp; Target.Address &amp; " 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
      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 "Labor": Labor c
              Case "Union Dues": UnionDues c
              Case "Other": Other c
          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" &amp; c.Row)
          strFindB = Sheets("Master").Range("B" &amp; c.Row)
          strFindC = Sheets("Master").Range("C" &amp; c.Row)
          strFindD = Sheets("Master").Range("D" &amp; c.Row)
          strFindE = Sheets("Master").Range("E" &amp; c.Row)
          strFindF = Sheets("Master").Range("F" &amp; 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 " &amp; i
          GoTo skip:
  
          End If
  
          Next i
  
      End With
  End If
  skip:
  
      Next c
  End If
  End Sub
  </code></pre>
  
  <p>Here is the case macro that is fired off from the above code (there is a similar macro for each case). These are in the Module:</p>
  
  <pre><code>Sub Power(c As Range)
  
  Dim rng As Range
  
  Set rng = Nothing
  Set rng = Range("A" &amp; c.Row &amp; ":F" &amp; c.Row) '&lt;&lt; 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" &amp; c.Row &amp; ":F" &amp; c.Row).Copy
      End With
      .Offset(1, 0).PasteSpecial xlPasteFormats
      Application.CutCopyMode = False
  
  End With
  
  End Sub
  </code></pre>
  
  <p>Here is a link to the spreadsheet: <a href="http://1drv.ms/x/s!Amd7vhcV4dnOcJsB3KUiCLn6kPI" rel="nofollow noreferrer">1drv.ms/x/s!Amd7vhcV4dnOcJsB3KUiCLn6kPI</a>.</p>
  
  <p>Any Suggestions?</p>