Hi, I have a user who has approached me with an Excel coding issue.
Here is the problem and the code. If anyone can run through this and fix then it would be most appreciated. I simply do not have the knowledge or skill in this area to assist. Run-time Error ‘9’: Subscript Out of Range which pops out every time I open the excel spreadsheet. Full Code is featured below. It does two things: 1. allows multiple entries in the same cell using the drop down options of a data validation function. 2. Allows the users to type their name in cell A1 which then automatically allows the user to locate the column containing their name. However, there are a number of problems: • when you delete the entry from within the cell itself, the end if statements loops so that even if the new value is deleted it would just replicate old and new entries hence the entries appears twice, three times or however many entries you delete. • There is a Microsoft Visual Basic – Run-time Error ‘9’: Subscript Out of Range which pops out every time the document is opened • Another dialogue box pops open when the document is saved - compatibility checker • ‘Summary – Minor loss of fidelity o Some formulas in this workbook are linked to other workbooks that are closed (NB: This spreadsheet has been taken off from the web but the sheets are hidden), When these formulas are recalculated in earlier versions of excel without opening the linked workbooks, characters beyond the 255 character limit cannot be returned…Location: Defined names o An embedded object in this worksheet is created in a newer version of office. You cannot edit it in an earlier version of excel…location: Read me. I’ll save a blank version on the h/general/jw The code…. Option Explicit Private Sub Worksheet_Change(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 = 2 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If If Target.Column = 3 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If If Target.Column = 4 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If If Target.Column = 5 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If If Target.Column = 6 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If If Target.Column = 7 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If If Target.Column = 8 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If If Target.Column = 9 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If If Target.Column = 10 Then If oldVal = "" Then 'do nothing Else If newVal = "" Then 'do nothing Else Target.Value = oldVal _ & ", " & newVal End If End If End If exitHandler: Application.EnableEvents = True Dim Found As Range If Target.Address(False, False) = "A1" Then Set Found = Rows(3).Find(what:=Target.Value, LookIn:=xlValues, lookat:=xlWhole) If Found Is Nothing Then MsgBox "Error in name!" Else Found.Offset(1).Select End If End If End Sub -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com 4. Learn VBA Macros at http://www.quickvba.blogspot.com 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com <><><><><><><><><><><><><><><><><><><><><><> HELP US GROW !! We reach over 7000 subscribers worldwide and receive many nice notes about the learning and support from the group.Let friends and co-workers know they can subscribe to group at http://groups.google.com/group/excel-macros/subscribe