Solved

Adding another Private Sub Worksheet_Change in Excel 2010

Posted on 2014-03-02
6
554 Views
Last Modified: 2014-03-02
I am implementing the following code found through this website to simulate autocomplete in column A of a worksheet called "NEW_Procedures" using data from a named range called "Location" located in another worksheet called "Lookups". I would like to also use autocomplete for column D in worksheet "NEW_Procedures" using data from a named range called "ProcedureIdent" in worksheet "Lookups".

How do I add another Private Sub Worksheet_Change as described above to the existing code below?

Private Sub Worksheet_Change(ByVal Target As Range)
     'Sub "autocompletes" data entered into column A using a source table on a different worksheet. If more than one match is
     '    found, the user is allowed to continue entering characters until a unique match is found. If no matches are found, the
     '    data is accepted as entered. ALT + Enter, Enter to force the macro to accept data as entered. The sub is triggered by
     '    the Enter key.
    Dim cel As Range, match1 As Range, match2 As Range, rg As Range, targ As Range
     
     '***Please adjust the next two statements before using this code!***
    Set targ = Intersect(Target, Range("A:A")) 'Watch the cells in column A
    Set rg = Worksheets("Lookups").Range("Location") 'Use named range Location for "autocomplete" info
     
    If targ Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errhandler 'If code encounters an error, turn events back on
     
    For Each cel In targ
        If Not IsError(cel) Then
            If cel <> "" And Right(cel, 1) <> Chr(10) Then
                Set match1 = Nothing
                Set match1 = rg.Find(cel & "*", lookat:=xlWhole, MatchCase:=False) 'Match is case insensitive
                If Not match1 Is Nothing Then
                    Set match2 = rg.FindNext(after:=match1)
                    If match2.Address = match1.Address Then 'Code is fooled by identical strings in two cells
                        cel = match1 'Only one match found. Use it to "autocomplete" the cell
                    Else 'More than one match found. User must enter more data. Return to "Edit" mode
                        cel.Activate
                        Application.SendKeys ("{F2}") 'Begin editing after last character entered
                    End If
                Else 'No matches found. Do not change entered text
                End If
            Else 'Strip the line feed from the end of the text string
                If cel <> "" And Right(cel, 1) = Chr(10) Then cel = Left(cel, Len(cel) - 1)
            End If
        End If
    Next cel
     
errhandler:     Application.EnableEvents = True
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Open in new window


Thanks,
Andrea
0
Comment
Question by:Andreamary
  • 2
  • 2
6 Comments
 
LVL 33

Assisted Solution

by:Norie
Norie earned 250 total points
ID: 39899148
You can only have one Worksheet_Change event.

What you need to do is add/change the existing code to include column D.

Try this, it checks if a cell in column A or D has been changed and determines which range to use based on the column.
Private Sub Worksheet_Change(ByVal Target As Range)
     'Sub "autocompletes" data entered into column A using a source table on a different worksheet. If more than one match is
     '    found, the user is allowed to continue entering characters until a unique match is found. If no matches are found, the
     '    data is accepted as entered. ALT + Enter, Enter to force the macro to accept data as entered. The sub is triggered by
     '    the Enter key.
    Dim cel As Range, match1 As Range, match2 As Range, rg As Range, targ As Range
     
     '***Please adjust the next two statements before using this code!***
    Set targ = Intersect(Target, Range("A:A, D:D")) 'Watch the cells in column A
    If targ Is Nothing Then Exit Sub
    
    Select Case Target.Column
    
        Case 1
            Set rg = Worksheets("Lookups").Range("Location") 'Use named range Location for "autocomplete" info
        Case 4
            Set rg = Worksheets("Lookups").Range("ProcedureIdent") 'Use named range Location for "autocomplete" info
    End Select
    
     
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errhandler 'If code encounters an error, turn events back on
     
    For Each cel In targ
        If Not IsError(cel) Then
            If cel <> "" And Right(cel, 1) <> Chr(10) Then
                Set match1 = Nothing
                Set match1 = rg.Find(cel & "*", lookat:=xlWhole, MatchCase:=False) 'Match is case insensitive
                If Not match1 Is Nothing Then
                    Set match2 = rg.FindNext(after:=match1)
                    If match2.Address = match1.Address Then 'Code is fooled by identical strings in two cells
                        cel = match1 'Only one match found. Use it to "autocomplete" the cell
                    Else 'More than one match found. User must enter more data. Return to "Edit" mode
                        cel.Activate
                        Application.SendKeys ("{F2}") 'Begin editing after last character entered
                    End If
                Else 'No matches found. Do not change entered text
                End If
            Else 'Strip the line feed from the end of the text string
                If cel <> "" And Right(cel, 1) = Chr(10) Then cel = Left(cel, Len(cel) - 1)
            End If
        End If
    Next cel
     
errhandler:
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 81

Accepted Solution

by:
byundt earned 250 total points
ID: 39899174
imnorie forgot to turn events back on at the end of the sub. As a result, the Worksheet_Change sub triggers only once.

The following code puts the targets and lookup ranges in unions of ranges. It then loops through the areas of those unions to get the answer. The code will work as many times in a row as you like.

Private Sub Worksheet_Change(ByVal Target As Range)
     'Sub "autocompletes" data entered into column A using a source table on a different worksheet. If more than one match is
     '    found, the user is allowed to continue entering characters until a unique match is found. If no matches are found, the
     '    data is accepted as entered. ALT + Enter, Enter to force the macro to accept data as entered. The sub is triggered by
     '    the Enter key.
    Dim cel As Range, match1 As Range, match2 As Range, rg As Range, targ As Range
    Dim i As Long
    Dim Targets As Range, Sources As Range
    Set Targets = Union(Range("A:A"), Range("D:D"))
    With Worksheets("Lookup")
        Set Sources = Union(.Range("Location"), .Range("ProcedureIdent"))
    End With
    
     
     '***Please adjust the next two statements before using this code!***
    For i = 1 To Targets.Areas.Count
        Set targ = Intersect(Target, Targets.Areas(i)) 'Watch these cells for user input
        Set rg = Sources.Areas(i) 'Use named range for "autocomplete" info
         
        If Not targ Is Nothing Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            On Error GoTo errhandler 'If code encounters an error, turn events back on
             
            For Each cel In targ
                If Not IsError(cel) Then
                    If cel <> "" And Right(cel, 1) <> Chr(10) Then
                        Set match1 = Nothing
                        Set match1 = rg.Find(cel & "*", lookat:=xlWhole, MatchCase:=False) 'Match is case insensitive
                        If Not match1 Is Nothing Then
                            Set match2 = rg.FindNext(after:=match1)
                            If match2.Address = match1.Address Then 'Code is fooled by identical strings in two cells
                                cel = match1 'Only one match found. Use it to "autocomplete" the cell
                            Else 'More than one match found. User must enter more data. Return to "Edit" mode
                                cel.Activate
                                Application.SendKeys ("{F2}") 'Begin editing after last character entered
                            End If
                        Else 'No matches found. Do not change entered text
                        End If
                    Else 'Strip the line feed from the end of the text string
                        If cel <> "" And Right(cel, 1) = Chr(10) Then cel = Left(cel, Len(cel) - 1)
                    End If
                End If
            Next cel
        End If
    Next
    
errhandler:
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

Open in new window

0
 
LVL 33

Expert Comment

by:Norie
ID: 39899222
byundt

The original code didn't turn events back on, which I should have noticed and remedied.
0
 

Author Comment

by:Andreamary
ID: 39899230
Terrific, and thanks for improving on the original code...
0
 

Author Closing Comment

by:Andreamary
ID: 39899249
Hi Brad,

Thanks for the guidance...I will rectify as advised, and thanks to you both!

Andrea
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

In this article I will provide some simple productivity hacks that will help you use Google to specifically show results from any web site (Experts-Exchange.com in my example), with minimal effort in Chrome and Firefox. I've seen a common theme a…
Today companies are subjected to more-and-more data, and it won't stop any time soon.  But there are obvious opportunities for reducing data, particularly data duplicated among companies.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now