Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / General Excel Questions / August 2007

Tip: Looking for answers? Try searching our database.

Referring to Ranges in Change-Event Macro?

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Wuddus - 24 Aug 2007 18:26 GMT
I stole the bulk of the following code from one of Dave Peterson's many
helpful postings on this site. I have  a number of named lists on the sheet
called "Feed Data." The lists are named "list1," list2," list3," etc. Each
one is defined with an OFFSET function.

Data Validation in various columns on the main sheet refer to these lists
for their dropdowns. (The DV is set up to accept non-list entries after
showing a warning box.). The macro that follows allows users to have new,
non-source list entries to be added onto the original list so that it
subsequently appears in the dropdowns. (Again, there are several lists
(seven), each one used as a DV list for a different column on the main sheet
(Column A, Column B, etc.)) In adapting it for my workbook, however, I
clearly did someting wrong, because it works great--but only for one cell in
each column (a1, b1, c1, etc.)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myList As Range

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("a1,b1,c1,d1,e1,f1,g1")) Is Nothing Then Exit
Sub
If Target.Value = "" Then Exit Sub

Set myList = Nothing
Select Case LCase(Target.Address(0, 0))
Case Is = "a1"
Set myList = Me.Parent.Worksheets("Feed Data").Range("list1")
Case Is = "b1"
Set myList = Me.Parent.Worksheets("Feed Data").Range("list2")
Case Is = "c1"
Set myList = Me.Parent.Worksheets("Feed Data").Range("list3")
Case Is = "d1"
Set myList = Me.Parent.Worksheets("Feed Data").Range("list4")
Case Is = "e1"
Set myList = Me.Parent.Worksheets("Feed Data").Range("list5")
Case Is = "f1"
Set myList = Me.Parent.Worksheets("Feed Data").Range("list6")
Case Is = "g1"
Set myList = Me.Parent.Worksheets("Feed Data").Range("list7")
'etc
End Select

If myList Is Nothing Then
Exit Sub
End If

If IsNumeric(Application.Match(Target.Value, myList, 0)) Then
'already there, do nothing
Else
With myList
.Cells(.Cells.Count).Offset(1, 0).Value = Target.Value
Set myList = .Resize(.Rows.Count + 1, 1)
End With

With myList
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With
End If

End Sub

Again, the macro as it currently stands seems to work only for single-cell
ranges: a1, b1, c1, d1, etc. I need it to apply to a range of cells in each
column, though, so that (for example), if I use the DV dropdown in cell A2
and want to add an item not in List1, than the item will be added to List1.
I've tried modifiying the code like this:

...

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("a1:a500,b1,c1,d1,e1,f1,g1")) Is Nothing Then
Exit Sub
If Target.Value = "" Then Exit Sub

Set myList = Nothing
Select Case LCase(Target.Address(0, 0))
Case Is = "a1:a500"
Set myList = Me.Parent.Worksheets("Feed Data").Range("list1")

...

I figured that cells A1:A500 would be part of the change event, but nothing
happens. Does any of this make sense? What am I doing wrong? Help!
Bob Phillips - 24 Aug 2007 19:07 GMT
Something like this

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("A1:A500,b1,c1,d1,e1,f1,g1")) Is Nothing Then
Exit Sub
If Target.Value = "" Then Exit Sub

Set myList = Nothing
Select Case LCase(Target.Column)
Case 1
If Target.Row <= 500 Then _
Set myList = Me.Parent.Worksheets("Feed Data").Range("list1")
Case 2
If Target.Row = 1 Then _
Set myList = Me.Parent.Worksheets("Feed Data").Range("list2")

and then modify each case along the same lines.

Signature

HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

>I stole the bulk of the following code from one of Dave Peterson's many
> helpful postings on this site. I have  a number of named lists on the
[quoted text clipped - 88 lines]
> nothing
> happens. Does any of this make sense? What am I doing wrong? Help!
Wuddus - 24 Aug 2007 20:12 GMT
Bob: See my reply to Dave P., below. Thanks!

> Something like this
>
[quoted text clipped - 106 lines]
> > nothing
> > happens. Does any of this make sense? What am I doing wrong? Help!
Dave Peterson - 24 Aug 2007 19:10 GMT
Untested, but it did compile:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim myList As Range
   
   If Target.Cells.Count > 1 Then Exit Sub
   If Target.Value = "" Then Exit Sub
   
   With Me.Parent.Worksheets("Feed data")    
       Set myList = Nothing
       If Not (Intersect(Target, Me.Range("a1:a100")) Is Nothing) Then
           'in A1:A100
           Set myList = .Range("List1")
       ElseIf Not (Intersect(Target, Me.Range("b1:b1000")) Is Nothing) Then
           'in B1:B1000
           Set myList = .Range("List2")
       ElseIf Not (Intersect(Target, Me.Range("c1")) Is Nothing) Then
           'in C1
           Set myList = .Range("List3")
       'elseif and so on...
       End If
   End With

   If myList Is Nothing Then
       Exit Sub
   End If

   If IsNumeric(Application.Match(Target.Value, myList, 0)) Then
       'already there, do nothing
   Else
       With myList
           .Cells(.Cells.Count).Offset(1, 0).Value = Target.Value
           Set myList = .Resize(.Rows.Count + 1, 1)
       End With
   
       With myList
           .Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
       End With
   End If

End Sub

If you decide to add more ranges than 7, you may want to create a couple of
arrays and loop through them looking to see if you're in that associated range.

(Still untested, but compiled)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim myList As Range
   Dim myListNames As Variant
   Dim myRangeAddr As Variant
   Dim iCtr As Long
   
   myRangeAddr = Array("a1:a100", "b1:b44", "C1", "D1:f99")
   myListNames = Array("List1", "list2", "anothername", "afourthname")
   
   If UBound(myRangeAddr) <> UBound(myListNames) Then
       MsgBox "Design error!"
       Exit Sub
   End If
   
   If Target.Cells.Count > 1 Then Exit Sub
   If Target.Value = "" Then Exit Sub
   
   
   Set myList = Nothing
   For iCtr = LBound(myRangeAddr) To UBound(myRangeAddr)
       If Not (Intersect(Target, Me.Range(myRangeAddr(iCtr))) Is Nothing) Then
           'in that range
           Set myList _
                = Me.Parent.Worksheets("feed data").Range(myListNames(iCtr))
           Exit For
       End If
   Next iCtr

   If myList Is Nothing Then
       Exit Sub
   End If

   If IsNumeric(Application.Match(Target.Value, myList, 0)) Then
       'already there, do nothing
   Else
       With myList
           .Cells(.Cells.Count).Offset(1, 0).Value = Target.Value
           Set myList = .Resize(.Rows.Count + 1, 1)
       End With
   
       With myList
           .Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
       End With
   End If

End Sub

> I stole the bulk of the following code from one of Dave Peterson's many
> helpful postings on this site. I have  a number of named lists on the sheet
[quoted text clipped - 80 lines]
> I figured that cells A1:A500 would be part of the change event, but nothing
> happens. Does any of this make sense? What am I doing wrong? Help!

Signature

Dave Peterson

Wuddus - 24 Aug 2007 20:12 GMT
Thanks, Dave and Bob! I would never have come up with this! I'm going to try
both of your suggestions and see how they work out. I've already tried the
code that Dave suggested and had some trouble getting it to go (my
workstation froze up on me), but I'm suspecting I didn't get everything quite
right when I put it in my sheet. (I'm doing this between a number of other
projects, so I'm positive I just screwed it up in my stupid haste.) I'll try
it again at home this weekend, but I'm confident it's going to work.

Again, thank you both! I've benefitted from both of your postings for a long
time now, and I really appreciate your patience and willingness to help. I'm
sure everyone else does, too!

> Untested, but it did compile:
>
[quoted text clipped - 178 lines]
> > I figured that cells A1:A500 would be part of the change event, but nothing
> > happens. Does any of this make sense? What am I doing wrong? Help!
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.