how to use two macros using one worksheet in excel

For data validation, I used the list option, with the source being

=NameList

To create a dynamic named range, insert a name NameList and have it refer to the formula

=OFFSET(Lists!$A$1,1,0,COUNTA(Lists!$A:$A)-1,1)"

As items are added, the list expands, and the DV list will be updated.

And this will allow you to delete entries:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range

Dim oldVal As String

Dim newVal As String

Dim lUsed As Long

Dim ws As Worksheet

Dim i As Integer

If Target.Cells.Count > 1 Then Exit Sub

If Target.Column < 5 Or Target.Column > 8 Then Exit Sub

If Target.Value = "" Then Exit Sub

On Error Resume Next

Set ws = Worksheets("Lists")

Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)

On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Not Intersect(Target, rngDV) Is Nothing Then

Application.EnableEvents = False

newVal = Target.Value

Application.Undo

oldVal = Target.Value

If oldVal = "" Then

Target.Value = newVal

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

If newVal <> "" And Application.WorksheetFunction.CountIf(ws.Range("NameList"), newVal) = 0 Then

i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

ws.Range("A" & i).Value = newVal

ws.Range("NameList").Sort Key1:=ws.Range("A1"), _

Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, _

Orientation:=xlTopToBottom

End If

End If

exitHandler:

Application.EnableEvents = True

End Sub

Bernie,

The code does not allow me to delete the new hard entries when inserted. It gives me issues when trying to delete them. Plus, it does not add the new entries to the list. The first part of the original Code 1 works, but not code 2 section of your new code. I'm not sure what you mean by this comment below. I dont have anything like the formula you have below. If your talking about data validation then I have =INDIRECT(SUBSTITUTE(E27," ","_")).  My data is on a different worksheet and start in cell E1:JC4. In E27 i have data validation as such, =Data!$E$1:$K$1. Remeber all my data is on a different worksheet.

"It does help to have a description of how things should work: this assumes that NameList is a dynamic named range, along the lines of this (assuming you have a header in cell A1)

=OFFSET(Lists!$A$1,1,0,COUNTA(Lists!$A:$A)-1,1)"

If I could send you my file that might be best, Bernie. I'm not versed in your tech lingo.

It does help to have a description of how things should work: this assumes that NameList is a dynamic named range, along the lines of this (assuming you have a header in cell A1)

=OFFSET(Lists!$A$1,1,0,COUNTA(Lists!$A:$A)-1,1)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range

Dim oldVal As String

Dim newVal As String

Dim lUsed As Long

Dim ws As Worksheet

Dim i As Integer

If Target.Cells.Count > 1 Then Exit Sub

If Target.Column < 5 Or Target.Column > 8 Then Exit Sub

On Error Resume Next

Set ws = Worksheets("Lists")

Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)

On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Not Intersect(Target, rngDV) Is Nothing Then

Application.EnableEvents = False

newVal = Target.Value

Application.Undo

oldVal = Target.Value

If oldVal = "" Then

Target.Value = newVal

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

If newVal <> "" And Application.WorksheetFunction.CountIf(ws.Range("NameList"), newVal) = 0 Then

i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

ws.Range("A" & i).Value = newVal

ws.Range("NameList").Sort Key1:=ws.Range("A1"), _

Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, _

Orientation:=xlTopToBottom

End If

End If

exitHandler:

Application.EnableEvents = True

End Sub

Bernie, thanks for the reply. I pasted the code and the two things that i needed for the code to do have disappeared. I needed the code to:

1. allow for multiple selections in one cell, seperated by a comma (code 1)
2. allow for hard entry to the drop down list, then the hard entry becomes part of that list (code 2)

The two codes as I provided then allow for these two things to occur, but now the code does not do any of them. Maybe I inserted wrong. I simple deleted the "SecondPart:" in the code below and inserted the code back. I'm not a programmer and have no idea how to work with code, so parden the lack of knowledge.  If this makes it easier, then lets have both parts of the code apply to F, G, and H. I need these two codes to become one. Basically, have them run as if its only one code. I don't know how to combine them.

Application.EnableEvents = True

Exit Sub

SecondPart:

On Error Resume Next

Dim ws As Worksheet

Maybe im using the wrong word "macro" and should be referring to them as code. I right clicked on the worksheet and selected view code. Its here where I insert the code. Inserting one code works, but how do i insert two codes and have them work?

I don't want it to bypass the first code. I want both codes to apply to F, G, and H.

This is how code two works:

Select a fruit from the dropdown list or type a new fruit name in the cell.

New fruit will be automatically added to the list on the Lists worksheet.

You need a little bit of logic to handle the flow control: this will apply the second part only to columns E-H and the first part only to all other columns (if only one cell is being changed). If you want to apply the first part to all columns and then the  second part to columns E-H then that requires different logic.

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.Cells.Count > 1 Then GoTo exitHandler

If Target.Column >= 5 And Target.Column <= 8 Then GoTo SecondPart

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

If Target.Column = 7 Or 8 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

Application.EnableEvents = True

Exit Sub

SecondPart:

On Error Resume Next

Dim ws As Worksheet

Dim i As Integer

Set ws = Worksheets("Lists")

If Target.Row > 1 Then    'If Target.Column = 3 And Target.Row > 1 Then

If Application.WorksheetFunction.CountIf(ws.Range("NameList"), Target.Value) Then

Exit Sub

Else

Application.EnableEvents = False

i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

ws.Range("A" & i).Value = Target.Value

ws.Range("NameList").Sort Key1:=ws.Range("A1"), _

Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, _

Orientation:=xlTopToBottom

Application.EnableEvents = True

End If

End If

exitHandler:

Application.EnableEvents = True

End Sub