Multi selection to a single cell and in a combined cell

[cgibson92]

I need for my multi selection in the data validation list box to populate in the columns to the right in a single cell and still continuing to populating in the same cell. Below is my code any help is appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String, newVal As String
Dim v As Variant, ws As Worksheet

On Error GoTo exitHandler

If Target.Count > 1 Or Target.Text = "" Then Exit Sub

If Not Intersect(Range("B36,B47"), Target) Is Nothing Then

Application.EnableEvents = False
newVal = Target.Text
Application.Undo
oldVal = Target.Text
Target.value = newVal

If oldVal <> "" Then

If oldVal = newVal Then
Target.value = ""
ElseIf InStr(1, oldVal, newVal) > 0 Then
If Right(oldVal, Len(newVal)) = newVal Then
Target.value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
Else
Target.value = Replace(oldVal, newVal & Chr(10), "")
End If
Else
Target.value = oldVal & Chr(10) & newVal
End If

End If

Application.ScreenUpdating = False

For Each ws In Sheets(Array("Admin Fee", "Flat Fee", "Market Share", "Override"))
ws.Visible = False
Next ws

For Each v In Array("Admin Fee", "Business Development Bonus ", "Business Development Fee", _
"Flat Fee", "Global Business Development Bonus", "Maintenance Bonus", _
"Override", "Partnership Fee", "Transaction / Service Fee", _
"Select Incentive Type (s)")

If InStr(Target.value, v) Then
Select Case v
Case "Admin Fee", "Transaction / Service Fee"
Sheets("Admin Fee").Visible = True
'Sheets("Admin Fee").Select

Case "Business Development Bonus ", "Flat Fee", "Partnership Fee"
Sheets("Flat Fee").Visible = True
'Sheets("Flat Fee").Select

Case "Business Development Fee", "Override"
Sheets("Override").Visible = True
'Sheets("Override").Select

Case "Global Business Development Bonus", "Maintenance Bonus"
Sheets("Market Share").Visible = True
'Sheets("Market Share").Select

Case "Select Incentive Type (s)"

Case Else

End Select
End If
Next v

End If

exitHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox Err.Description, vbCritical, "Worksheet_Change Error: " & Err.Number

End Sub


Thanks
Cindy