Hi Lokesh3_14
Welcome to the Forum!!!
I didn't rewrite your existing Code, merely modified it. As dflak noted, there are other ways to do this...some better than others. Modified Code..
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, LastRow As Long, n As Long
Dim LR As Long
Dim MyCol As Collection
Dim SearchString As String, Templist As String
Application.EnableEvents = False
LR = Range("A" & Rows.Count).End(xlUp).Row
On Error GoTo Whoa
' Find LastRow in Col A
LastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Columns(1).EntireColumn) Is Nothing Then
Set MyCol = New Collection
' Get the data from Col A into a collection
For i = 4 To LastRow
If Len(Trim(Sheet2.Range("A" & i).Value)) <> 0 Then
On Error Resume Next
MyCol.Add CStr(Sheet2.Range("A" & i).Value), CStr(Sheet2.Range("A" & i).Value)
On Error GoTo 0
End If
Next i
' Create a list for the Data Validation List
For n = 1 To MyCol.Count
Templist = Templist & "," & MyCol(n)
Next
Templist = Mid(Templist, 2)
Range("B2:B" & LR).ClearContents: Range("B2:B" & LR).Validation.Delete
' Create the Data Validation List
If Len(Trim(Templist)) <> 0 Then
With Range("B2:B" & LR).Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Templist
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
' Capturing change in cell A2
ElseIf Not Intersect(Target, Range("B2:B" & LR)) Is Nothing Then
SearchString = Target.Value
'SearchString = Range("B2").Value
Templist = FindRange(Sheet2.Range("A2:A" & LastRow), SearchString)
'Range("C2:C" & LastRow).ClearContents
' Range("C2:C" & LastRow).Validation.Delete
Cells(Target.Row, "C").Validation.Delete
If Len(Trim(Templist)) <> 0 Then
' Create the DV List
With Cells(Target.Row, "C").Validation
' With Range("C2:C" & LastRow).Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Templist
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Bookmarks