Adding drop down List to Cell

I have the following code below but I can not seem to get the syntax correct with it. I am wanting the program to check when cells A1:A5 is empty. If the range is not empty then take the one cells to the right using the "offset(0,1)" and put a dropdown list titled "Categories" in it. Below is what I have this far.

Code:

Sub Add_Drop_Down_Menu_Cell()
Dim Cell As Range
Dim Rng As Range
Set Rng = Sheets("Sheet1").Range("A1:A5").Validation
For Each Cell In Rng
If Cell.Value <> Empty Then
Cell.Offset(0, 1).Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
*Formula1:="=Categories"*
.IgnoreBlank = True
.InCellDropdown = True
If Answer = vbCancel Then Exit Sub
End If
Next Cell
End Sub

Sorry about that.

I have the following code below but I can not seem to get the syntax correct with it. I am wanting the program to check when cells A1:A5 is empty. If the range is not empty then take the one cells to the right using the "offset(0,1)" and put a dropdown list titled "Categories" in it. Below is what I have this far.

Sub Add_Drop_Down_Menu_Cell()
Dim Cell As Range
Dim Rng As Range
Set Rng = Sheets("Sheet1").Range("A1:A5").Validation
For Each Cell In Rng
If Cell.Value <> Empty Then
Cell.Offset(0, 1).Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
*Formula1:="=Categories"*
.IgnoreBlank = True
.InCellDropdown = True
If Answer = vbCancel Then Exit Sub
End If
Next Cell
End Sub

I am using the function "Private Sub Worksheet_Change(ByVal Target As Range)" to call a macro that simply adds a dropdown list to right of the "Cell". Below is the first part of the macro using the Private Sub Work_Sheet and then the call of the macro "Add_Drop Down_Menu_Cell

If Intersect(Target, Range("A1:A5")) Is Nothing Then Exit Sub
   Call Add_Drop_Down_Menu_Cell
End Sub

Now lets say cell A3 has a value in it then using the below macro to put a dropdown list in cell B3. There might be a more efficient way to do this but I am new to using macros. Right now I get an error message Compile Error: Method or data member not found. I also wonder if there is a way to delete the cell contents in Range (B1:B5) if the range in A1:A5 is empty.

Sub Add_Drop_Down_Menu_Cell()
    Dim Cell As Range
    Dim Rng As Range
          Set Rng = Sheets("Sheet1").Range("A1:A5")
            For Each Cell In Rng
                If Cell.Value <> Empty Then
                
                Cell.Offset(0, 1).Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                      Operator:=xlBetween, Formula1:="=Categories"                    
                End If
            Next Cell
End Sub

Winon,

Thanks for the help on this I greatly appreciate it. Just a quick question how do you get the message box you post to the show up? The code is attached below. Have a great day.

Private Sub Worksheet_Activate()
MsgBox "Hello", vbOKOnly, ("Greetings")
End Sub

Dear Winon,

I am eventually going to have that code look over the Range C1:C500. I tested the code from C1:C500 and it seems to take about 30 seconds. Is there a way either in the Worksheet_Change or in the Macro itself to get the code to only look at the value that has recently changed. Meaning lets C5 changes, which triggers the Macro to run but the Macro looks over the entire range from C1:C500. Is there a way to just get the Worksheet_Change or Macro to run only over C5 (i.e. the cell that changes). I tried in the Macro changing it to ActiveCell but it does not work. If I change C5 and hit ENTER the activecell goes to C6 and the macro adds a dropdown list to C6. Similarly if I change C5 and hit the right arrow buttom it adds a dropdown list to E5. Any thoughts on this? Below is what I got from you and I added some edits to it.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("C8:C500")) Is Nothing Then Exit Sub
   Call Add_DropDown_In_ColumnD
End Sub

Sub Add_DropDown_In_ColumnD()
    Dim Cell As Range
    Dim Rng As Range
          Set Rng = ActiveSheet.Range("C8:C500")
          For Each Cell In Rng
           If Cell.Value <> Empty Then
               Cell.Offset(0, 1).Interior.ColorIndex = 6
                With Cell.Offset(0, 1).Validation
                   .Delete
                   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:= _
                    "=Accounts"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
  
                End With
            Else
                Cell.Offset(0, 1).Clear
                Cell.Offset(0, 1).Interior.ColorIndex = 2
                With Cell.Offset(0, 1).Validation
                   .Delete
                End With
            End If
            Next
End Sub

Pl try this code.It gives drop down list (=Accounts) after making some entry in the cells C1:C500 in the changed cell.
If value is entered in C5 drop down appears in C5.
Any clarifications welcome.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vfyrng As Range

Set Vfyrng = Range("C1:C500")

If Not Intersect(Vfyrng, Target) Is Nothing Then

If Target.Value <> "" Then
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Accounts"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Cell Validated"
        .InputMessage = ""
        .ErrorMessage = "Cell validated.Select from dropdown list."
        .ShowInput = True
        .ShowError = True
    End With
Else
 Target.Validation.Delete
End If

End If

End Sub

kvsrinivasamurthy,

That code worked great and fast. Just as a side note is there a way to write the code where it calls a macro under the Private Sub then actually runs the code instead of a long Private Sub code. I am eventually going to have several codes that look like that the one you posted and for organization it would be easier to breakout the codes into different macros. Something along the lines of the codes below. Thanks for the help.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vfyrng As Range
Set Vfyrng = Range("C1:C500")
If Not Intersect(Vfyrng, Target) Is Nothing Then
    Call Macro Here
End If
End Sub

Then

Sub Macro
If Target.Value <> "" Then
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Accounts"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Cell Validated"
        .InputMessage = ""
        .ErrorMessage = "Cell validated.Select from dropdown list."
        .ShowInput = True
        .ShowError = True
    End With
Else
 Target.Validation.Delete
End If
End Sub

Pl try these two codes, to have separate macro.A spare cell DA1 is used.
Clarifications welcome.

Code1 for worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vfyrng As Range
Set Vfyrng = Range("C1:C500")

If Not Intersect(Vfyrng, Target) Is Nothing Then
[DA1] = Target.Address
Run "Macro1"
End If
End Sub

Code2 for Macro

Private Sub Macro1()
Dim K As String
K = [DA1]
If Range(K).Value <> "" Then
    With Range(K).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Accounts"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Cell Validated"

        .InputMessage = ""
        .ErrorMessage = "Cell validated.Select from dropdown list."
        .ShowInput = True
        .ShowError = True
    End With
Else
Range(K).Validation.Delete
End If

End Sub