Populate another cell from previous cell with multiple selections

Spikenaylor

Board Regular
Joined
Apr 14, 2013
Messages
109
Office Version
  1. 365
Platform
  1. Windows
Hi there.

my spreadsheet uses a code that picks from a dropdownlist and allows multiple selections into the cell and allows to remove selections from the cell. code is shown below.

It all works as it should, but now I want:

to be able to chose a selection from the dropdown list and with a particular match, it (runs another sub to do other things, in this case to populate another cell)

I want the matched selection to run the sub from an empty cell, or from multiple selection, but NOT on removing the multiple selection.

ie.

Word to match in example below is "build"

Blank Cell scenario.

pick dropdown list choose "build"

sub is called and runs.

Already polulated Cell Scenario ( cell populated with "drain, plug")

pick dropdown list choose "build"

"build" is added to cell contents by existing code, and sub is called and runs.

Already polulated Cell Scenario ( cell populated with "drain, plug, build")

pick dropdown list choose "build"

"build" is removed from cell contents by existing code, but sub is NOT called.


I am struggling to work out how to do this
any help or advice would be great


Code:
Option Explicit
' Developed by Contextures Inc.
' [URL="http://www.contextures.com/"]www.contextures.com[/URL]
' 
 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long

If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  ' Allows code to run on set columns in spreadsheet
   If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 12 Then
    If oldVal = "" Then
      'do nothing
      Else
        If newVal = "" Then
      'do nothing
      Else
 
        lUsed = InStr(1, oldVal, newVal)
  
            If lUsed > 0 Then
                If Right(oldVal, Len(newVal)) = newVal Then
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
 
                Else
                Target.Value = Replace(oldVal, newVal & ", ", "")
            
                End If
            Else
  
            Target.Value = oldVal _
              & ", " & newVal
        End If
                                    
      End If
    End If
    
    
    
  End If
End If
exitHandler:
  Application.EnableEvents = True
End Sub

'Sub to be run when matched word is picked from dropdownlist
Sub washprepareapopulate()


MsgBox "routine is running ", vbOKOnly
End Sub
 

Some videos you may like

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
I think this would work. See red font area.
Code:
Option Explicit
' Developed by Contextures Inc.
' [URL="http://www.contextures.com"]www.contextures.com[/URL]
' 
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  ' Allows code to run on set columns in spreadsheet
   If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 12 Then
    If oldVal = "" Then
      'do nothing
      Else
        If newVal = "" Then
      'do nothing
      Else 
        lUsed = InStr(1, oldVal, newVal)  
            If lUsed > 0 Then
                If Right(oldVal, Len(newVal)) = newVal Then
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2) 
                Else
                Target.Value = Replace(oldVal, newVal & ", ", "")            
                End If
            Else  
            Target.Value = oldVal _
              & ", " & newVal
        End If                                    
      End If
    End If    
  End If
End If
   [COLOR=#b22222]If InStr(Target.Value, "build") > 0 Then
         washprepareapopulate
    End If
[/COLOR]exitHandler:
  Application.EnableEvents = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,657
Messages
5,597,391
Members
414,142
Latest member
Banyangt

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top