Solved

Adding another Private Sub Worksheet_Change in Excel 2010

Posted on 2014-03-02
6
581 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
6 Comments
 
LVL 34

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 34

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

Salesforce Made Easy to Use

On-screen guidance at the moment of need enables you & your employees to focus on the core, you can now boost your adoption rates swiftly and simply with one easy tool.

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

687 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