Solved

Adding another Private Sub Worksheet_Change in Excel 2010

Posted on 2014-03-02
6
549 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 80

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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Meetings to discuss business process can waste time, and often do .  The meeting's dialog can get confusing when participants have different professional perspectives and backgrounds.  A jointly-developed process picture helps wade through the confu…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

760 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

20 Experts available now in Live!

Get 1:1 Help Now