Drop Down list with color

[jerrypatos]

Hi, I am new to excel vba and need your help.

My table consist of several lines like the example I attach.

I want to automatically create a drop list or update an already created one when the code (loop? I dont know) finds color Grey . Then pick the name of that cell and create a new item at drop down in order when select it to go to that cell.

Is this possible?

Cheers!

[KOKOSEK]

So, you need 2 macros.

1st to create/update dropdown list, into standard module:

Sub RefreshDropDown()
Dim AStr As String
Dim cell As Range
With Sheet9
    For Each cell In .Range("B2:C150")
        If cell.Interior.Color = 12566463 Then AStr = AStr & "," & cell.Value
    Next cell
    AStr = Right(AStr, Len(AStr) - 1)
    With .Range("B2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AStr
    End With
End With
End Sub

I do not understand that how do you want to trigger it to rebuild but it will create drop-down in B2 with values from grey cells.

2nd into sheet code (based on chosen value from drop-down, value is found and select):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B2]) Is Nothing Then
    With ActiveSheet.Range("B2:C150")
        Set c = .Find(Target.Value, LookIn:=xlValues)
        If Not c Is Nothing Then
            c.Select
        End If
    End With
End If
End Sub

[jerrypatos]

Dear KOKOSE

Thank you for your reply!

I was wondering if this can be done with range of cells , ie B12:B1000 and I12:1000 I tried but no luck.

[KOKOSEK]

Do you mean instead of

For Each cell In .Range("B2:C150")

check colours also in other ranges (B12:B1000 and I12:I10000)?

Try like this:

Private Sub Worksheet_Change(ByVal Target As Range)
Set rng1 = Union(Range("B2:C150"), Range("B12:B1000"), Range("I12:I1000"))
If Not Intersect(Target, [B2]) Is Nothing Then
    With rng1
        Set c = .Find(Target.Value, LookIn:=xlValues)
        If Not c Is Nothing Then
            c.Select
        End If
    End With
End If
End Sub

Sub RefreshDropDown()
Dim AStr As String
Dim cell As Range
Set rng1 = Union(Range("B2:C150"), Range("B12:B1000"), Range("I12:I1000"))
With Sheet9
    For Each cell In rng1
        If cell.Interior.Color = 12566463 Then AStr = AStr & "," & cell.Value
    Next cell
    AStr = Right(AStr, Len(AStr) - 1)
    With .Range("B2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AStr
    End With
End With
End Sub