Multiple VBA Codes on One Sheet - HOW??

[KDuser]

Hi - Using Excel 2007 - I have found two very useful VBA codes (shown below) the 1st copies all my data validation from one row to the next each time a user enters something in cell A1. The next allows my users to select multiple items from my data validation list. I need to run both of these on one sheet. How do I do it? I tried just copy/pasting one under the other and it said the "Worksheet_Change" name was already use (or something like that); then I tried changing the "Worksheet_Change" name to "Worksheet_Change2" - then it gave me an error saying that nothing can come after an End Sub. I tried deleting the 1st End Sub line - but that didn't work.

Obviously you can tell I'm a newbie at VBA - but I'm just starting to learn. Appreciate the help.

Kelly


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'setup to extablish column A as the Target Column to trigger the routine
If Target.Columns.Count > 1 Then Exit Sub
If Target.Row < 2 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
Dim x As Long
x = Target.Row

'METHOD 1
'Comment out any columns you do not wish to be copied down to the next row.
'One Column At A Time
'Copies data from Column B to the next Row.
'Cells(x - 1, 2).Copy Cells(x, 2)
''Copies data from Column C to the next Row.
'Cells(x - 1, 3).Copy Cells(x, 3)
'
''2 Columns at a time
''Copies data from Column D & E to the next Row.
'Range(Cells(x - 1, 4), Cells(x - 1, 5)).Copy Cells(x, 4)
'Range(Cells(x - 1, 6), Cells(x - 1, 7)).Copy Cells(x, 6)
'Range(Cells(x - 1, 8), Cells(x - 1, 9)).Copy Cells(x, 8)
'Range(Cells(x - 1, 10), Cells(x - 1, 11)).Copy Cells(x, 10)
'Range(Cells(x - 1, 12), Cells(x - 1, 13)).Copy Cells(x, 12)

'METHOD 2
'another good option is an array
Dim Cols As Variant
Dim C As Variant
'Add/Delete column numbers as required
Cols = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)

For Each C In Cols
Cells(x - 1, C).Copy Cells(x, C)
ActiveSheet.Range(Cells(x, 2), Cells(x, 12)).ClearContents
Next


End Sub
Option Explicit

Private Sub Worksheet_Change2(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
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
If Target.Column = 21 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub

 

[Blade Hunter]

Delete the second Option Explicit

 

[KDuser]

Thanks!!!

 

[KDuser]

Just tried it out and it still doesn't work - no error messages but only the 1st code works - still looking for help! Thanks..

 

[Blade Hunter]

Sorry I just realised, this in on the worksheet change event, you cant just put a 2 in the second one, you need to merge the code. I can look at this for you but not for a couple of hours, if no one has posted instructions for you within a couple of hours just bump the thread and I will do it for you.

 

[KDuser]

thanks again

Kelly

 

[KDuser]

Still looking for answers...is there any way to have have these codes in separate locations (sheet/module/ etc), instead of the same code sheet? Just a thought

 

[KDuser]

Ok - I got some other help from a great friend and we (read he) figured it out...thought I'd post the (very simple) solution here for everyone else:

Change name of first code to Worksheet_Change_A and second code to Worksheet_Change_B and then enter the following at the top of the 1st code

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Change_A Target
Worksheet_Change_B Target
End Sub