Copy formatting from a Range to a Cell via Drop-down list

[Luiz_Wiese]

Hello Guys,

I've been browsing for a while now and can't make it work. I've seen all the steps i need made on different threads but i can't join them due my lack of VBA syntax knowledge. Therefore I'm looking for help in the forum that helped me the most!!

I have a user colored dynamic range that i want to use as the source for the formats on a drop-down list i made via data validation. The user is going to use this code on new sheets and add new items and colors so it must be as generic as possible (I made it work with forced colors but its not what i really need ). I also could make it while pressing RUN on the VBE but i was hoping for an automated version, that updates whenever an item is selected on a new cell.

The steps i thought are:
1 - Compare the content of the selected item on the list to the source range with VLOOKUP;
2 - Get the addressed cell (From VLOOKUP) interior color (Maybe the whole format if going for fonts also);
3 - Apply the copied format to the selected item (Just like special paste format macros).

The attached image is my simplified data for now... (I've deleted lots of columns because it was originally huge [Source column on "AM" orig.] and not related to this situation)
Range A11 -> A61 Dropdown List
Range F2 -> F? Source names and formats (As extense as the user needs and as colorful too)

Thanks to all of you in advance and, if one could point me to somewhere to actively learn VBA coding I'd be more than grateful to come and help later

 

[Akuini]

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=OFFSET($AM$2,0,0,COUNTA(AM:AM),1)"

Wait, I don't understand why you need to add data validation formula by code, don't you already set up the data validation formula?

 

[GWteB]

@Luiz_Wiese I was off line for a while (I've had some family matters out of town...), glad to notice that with the help of @Akuini you're on your way with your project.
It crossed my mind that when you split up your input data and validation data to different sheets it could be more of ease. Furthermore, Excel has two features that come in handy:
1. the possibility to give a name to a certain range; 2. the possibility to make a table. With that in mind I've the following.

ad 1. When you select a certain range (multiple adjacent cells) and you open the name manager (ribbon > formulas > name manager > new) you can give that selected range a name. Using the name manager you can also change an existing name and that's what we (also) want to do.
ad 2. A table is a dynamic list. When you select a certain range (in this case preferably within one column, in connection with point 4 below) you can convert that range to a table (ribbon > start > format as table). Choose a style, mark the checkbox to confirm this table has a header (in your case "CLIENTE") and click OK. In the header a dropdown appears to check/uncheck items or to sort your items. This dropdown can be made hidden and visible again with the Filter button on the ribbon. A nice thing is, whenever you add an item at the bottom of the table, its range extends automatically. Such a dynamic table and its data can always been found, regardless on which sheet it's on.

The code has two parts, one has to be placed in the module of the user input sheet, the other part has to be placed in a regular module (in the VBA editor: Insert > Module). I did it this way for a better overview. You also can easily comment out the line that calls the separate sub (in the Worksheet_Change event). I made some comments in the code for better understanding. To make the code perform as intended, there are five important matters to take into account:
1. The row on the input sheet where the column headings are (Cliente, Etapa, Atividade) must have a name. Click upon the left hand vertical bar on the number of the desired row to select the entire row. Then open the name manager and give the entire row the name HEADINGS_InputSht. See also the first declaration in the main routine of the code below. You can change this one, but be sure that the declaration is equal to the name (in the name manager) of the range (ie row) where your headings are;
2. Make sure the values of these headings are equal to the headings of your tables upon the other sheet. To be sure you can use a formula;
3. Those tables must be renamed using the name manager; the name must be a concatenation of tblColored_ and the heading value of that table; eg tblColored_Cliente
The following also applies to the declaration in the code and the prefix of the table name. They must be the same, otherwise the colors (and other formatting as well) will not be retrieved;
4. Each table can only have one column (Excel provides more columns, I know ... but my code is somewhat "ancient". It would take me some time to modify this code in order to support multi column tables. I didn't think that was worth the effort).
5. Because the table(s) is/are upon another sheet the reference in the validation dialog can not made directly using the Refers To button, therefore you have to make use of the worksheet function INDIRECT; eg =INDIRECT("tblColored_Cliente")

This approach has the benefit that you can insert/delete rows/columns (almost) wherever you want. When you insert or delete a row/column at the upper/left hand side of your table, Excel updates everything automatically. The code keeps doing its job, provided that you stick to the above mentioned rules. Any other cell on the input sheet, whether it's formatted for data validation or not, is not affected. Still there are some disadvantages, in addition to the earlier mentioned. When you decide to change the color of an item in a table the colors on the input sheet will not be updated automatically. There might be more disadvantages, but you may find out yourself.

Module of the input sheet:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Call CopyCellFormatFromTable_TO_CellWithDataValidation(Target)

End Sub

Regular Module:

Option Explicit

Public Sub CopyCellFormatFromTable_TO_CellWithDataValidation(ByVal argTarget As Range)

    ' entire or partial names used in the name manager
    Const cStrNmdRng_HEADINGS_OnInputSht    As String = "HEADINGS_InputSht"      ' name of the row containing all the headings on the input sheet
    Const cStrNmdRng_LISTS_Prefix           As String = "tblColored_"            ' prefix for name of all user defined lists used on cells with data validation

    ' necessary declarations
    Dim oList                               As ListObject
    Dim c                                   As Range
    Dim rngList                             As Range
    Dim rngHeadingsOnInputSht               As Range
    Dim strHeadingOfTargetColumn            As String
    Dim strHeadingOfValList                 As String

    ' if no data validation in cell argTarget (ie validation is set on default: "all values") then JUMP
    ' (getting access to the Type property of the Validation object in such a case causes a runtime error)
    On Error GoTo NOTHING_TO_DO

    If argTarget.Validation.Type = xlValidateList Then

        ' Target Cell contains data validation by list, proceed and set error handler
        On Error GoTo SUB_ERROR
        ' determine whether Target Cell has a column heading or not
        Set rngHeadingsOnInputSht = GetNamedRange(cStrNmdRng_HEADINGS_OnInputSht)
        ' jump if there's no heading for this column
        If rngHeadingsOnInputSht Is Nothing Then GoTo SUB_EXIT
        strHeadingOfTargetColumn = argTarget.Parent.Cells(rngHeadingsOnInputSht.Row, argTarget.Column)
        ' jump if there's no heading for this column
        If strHeadingOfTargetColumn = "" Then GoTo SUB_EXIT

        ' at this point there seems to be a heading
        ' does it match with the heading of one of the user defined lists?
        Set oList = GetListObject(cStrNmdRng_LISTS_Prefix & strHeadingOfTargetColumn)

        ' jump if there's no list at all or no list with the same heading
        If oList Is Nothing Then GoTo SUB_EXIT
        If oList.Range Is Nothing Then GoTo SUB_EXIT
        If oList.Range.Count = 0 Then GoTo SUB_EXIT

        ' get the heading of the requested list
       'strHeadingOfValList = oList.Range.Formula1(1, 1)  ' (typically this line of code does NOT work)
        Set rngList = oList.Range
        strHeadingOfValList = rngList.Formula(1, 1)
        ' compare those two Headings with each other
        If StrComp(strHeadingOfTargetColumn, strHeadingOfValList, vbTextCompare) <> 0 Then GoTo SUB_EXIT

        ' at this point both headings are equal so we've found the correct list used for data validation
        ' check if value of Target appears in this list
        For Each c In rngList
            If StrComp(c.Value, argTarget.Value, vbTextCompare) = 0 Then
                With Application
                    .EnableEvents = False   ' prevent endless loop
                    c.Copy
                    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    .CutCopyMode = False
                    .EnableEvents = True
                End With
                Exit For
            End If
        Next c
    End If
   
SUB_EXIT:
    Set rngHeadingsOnInputSht = Nothing
    Set rngList = Nothing
    Set oList = Nothing
    Set c = Nothing
    Exit Sub
   
NOTHING_TO_DO:
    Err.Clear
    Resume SUB_EXIT
   
SUB_ERROR:
    MsgBox "Something went wrong in this sub; Error Data:" & vbCrLf & _
           "Number: " & Err.Number & vbCrLf & _
           "Source: " & Err.Source & vbCrLf & _
           "Description: " & Err.Description, vbExclamation, "Error message"
    Err.Clear
    Resume SUB_EXIT
End Sub


Public Function GetListObject(ByVal argName As String) As ListObject

    ' Return the list object (as ListObject) based on a given name (as String)
    Dim oWs         As Worksheet
    Dim oLO         As ListObject
    Dim bDone       As Boolean
    For Each oWs In ThisWorkbook.Worksheets
        For Each oLO In oWs.ListObjects
            If StrComp(oLO.Name, argName, vbTextCompare) = 0 Then
                Set GetListObject = oLO
                bDone = True
                Exit For
            End If
        Next oLO
        If bDone Then Exit For
    Next oWs
    Set oLO = Nothing
    Set oWs = Nothing
End Function


Public Function GetNamedRange(ByVal argName As String) As Range

    ' Return the range object (as Range) of a named range by a given name (as String)
    Dim n           As Name
    For Each n In ThisWorkbook.Names
        If StrComp(n.Name, argName, vbTextCompare) = 0 Then
            Set GetNamedRange = n.RefersToRange
            Exit For
        End If
    Next
    Set n = Nothing
End Function

 

[Luiz_Wiese]

Wait, I don't understand why you need to add data validation formula by code, don't you already set up the data validation formula?

I inserted the Data Validation on the code to make the range dynamic, otherwise I wouldn't be able to delete the blanks at the end of the source list (Unless I named the range just like GWteB mentioned, but I confess I didn't unterstand the videos nor the readings on the subject). I simply recorded a Macro while creating the Data Validation and changed the formula to a dynamic one.

Unfortunatelly I still have cells with other stuff after "TOTAL" as you can see below in the Image and checking the last cell with values bottom-up won't make it right . Anyway, this is just me trying an elegant approach to something I foresee. It is common for the user to add new rows when 60 is not enough for a month of inputs, and that's why I thought of inserting a dynamic range at that point in the code or leaving LOTS of cells already set with the validation if it couldn't be done.

Still, I'm more that happy with where it is now and I can leave the refinement to another ocasion (after I've taken a few more hours of study on VBA programming )

(All "merged" cells are actualy 'centered to selection' and not merged. Content is always on Column A)
Thanks Again and this time I promise I won't be bothering again so soon (At least not on this subject). Wish you a great week!

 

[Luiz_Wiese]

@Luiz_Wiese I was off line for a while (I've had some family matters out of town...), glad to notice that with the help of @Akuini you're on your way with your project.
It crossed my mind that when you split up your input data and validation data to different sheets it could be more of ease. Furthermore, Excel has two features that come in handy:
1. the possibility to give a name to a certain range; 2. the possibility to make a table. With that in mind I've the following.

ad 1. When you select a certain range (multiple adjacent cells) and you open the name manager (ribbon > formulas > name manager > new) you can give that selected range a name. Using the name manager you can also change an existing name and that's what we (also) want to do.
ad 2. A table is a dynamic list. When you select a certain range (in this case preferably within one column, in connection with point 4 below) you can convert that range to a table (ribbon > start > format as table). Choose a style, mark the checkbox to confirm this table has a header (in your case "CLIENTE") and click OK. In the header a dropdown appears to check/uncheck items or to sort your items. This dropdown can be made hidden and visible again with the Filter button on the ribbon. A nice thing is, whenever you add an item at the bottom of the table, its range extends automatically. Such a dynamic table and its data can always been found, regardless on which sheet it's on.

The code has two parts, one has to be placed in the module of the user input sheet, the other part has to be placed in a regular module (in the VBA editor: Insert > Module). I did it this way for a better overview. You also can easily comment out the line that calls the separate sub (in the Worksheet_Change event). I made some comments in the code for better understanding. To make the code perform as intended, there are five important matters to take into account:
1. The row on the input sheet where the column headings are (Cliente, Etapa, Atividade) must have a name. Click upon the left hand vertical bar on the number of the desired row to select the entire row. Then open the name manager and give the entire row the name HEADINGS_InputSht. See also the first declaration in the main routine of the code below. You can change this one, but be sure that the declaration is equal to the name (in the name manager) of the range (ie row) where your headings are;
2. Make sure the values of these headings are equal to the headings of your tables upon the other sheet. To be sure you can use a formula;
3. Those tables must be renamed using the name manager; the name must be a concatenation of tblColored_ and the heading value of that table; eg tblColored_Cliente
The following also applies to the declaration in the code and the prefix of the table name. They must be the same, otherwise the colors (and other formatting as well) will not be retrieved;
4. Each table can only have one column (Excel provides more columns, I know ... but my code is somewhat "ancient". It would take me some time to modify this code in order to support multi column tables. I didn't think that was worth the effort).
5. Because the table(s) is/are upon another sheet the reference in the validation dialog can not made directly using the Refers To button, therefore you have to make use of the worksheet function INDIRECT; eg =INDIRECT("tblColored_Cliente")

This approach has the benefit that you can insert/delete rows/columns (almost) wherever you want. When you insert or delete a row/column at the upper/left hand side of your table, Excel updates everything automatically. The code keeps doing its job, provided that you stick to the above mentioned rules. Any other cell on the input sheet, whether it's formatted for data validation or not, is not affected. Still there are some disadvantages, in addition to the earlier mentioned. When you decide to change the color of an item in a table the colors on the input sheet will not be updated automatically. There might be more disadvantages, but you may find out yourself.

Module of the input sheet:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Call CopyCellFormatFromTable_TO_CellWithDataValidation(Target)

End Sub

Regular Module:

Option Explicit

Public Sub CopyCellFormatFromTable_TO_CellWithDataValidation(ByVal argTarget As Range)

    ' entire or partial names used in the name manager
    Const cStrNmdRng_HEADINGS_OnInputSht    As String = "HEADINGS_InputSht"      ' name of the row containing all the headings on the input sheet
    Const cStrNmdRng_LISTS_Prefix           As String = "tblColored_"            ' prefix for name of all user defined lists used on cells with data validation

    ' necessary declarations
    Dim oList                               As ListObject
    Dim c                                   As Range
    Dim rngList                             As Range
    Dim rngHeadingsOnInputSht               As Range
    Dim strHeadingOfTargetColumn            As String
    Dim strHeadingOfValList                 As String

    ' if no data validation in cell argTarget (ie validation is set on default: "all values") then JUMP
    ' (getting access to the Type property of the Validation object in such a case causes a runtime error)
    On Error GoTo NOTHING_TO_DO

    If argTarget.Validation.Type = xlValidateList Then

        ' Target Cell contains data validation by list, proceed and set error handler
        On Error GoTo SUB_ERROR
        ' determine whether Target Cell has a column heading or not
        Set rngHeadingsOnInputSht = GetNamedRange(cStrNmdRng_HEADINGS_OnInputSht)
        ' jump if there's no heading for this column
        If rngHeadingsOnInputSht Is Nothing Then GoTo SUB_EXIT
        strHeadingOfTargetColumn = argTarget.Parent.Cells(rngHeadingsOnInputSht.Row, argTarget.Column)
        ' jump if there's no heading for this column
        If strHeadingOfTargetColumn = "" Then GoTo SUB_EXIT

        ' at this point there seems to be a heading
        ' does it match with the heading of one of the user defined lists?
        Set oList = GetListObject(cStrNmdRng_LISTS_Prefix & strHeadingOfTargetColumn)

        ' jump if there's no list at all or no list with the same heading
        If oList Is Nothing Then GoTo SUB_EXIT
        If oList.Range Is Nothing Then GoTo SUB_EXIT
        If oList.Range.Count = 0 Then GoTo SUB_EXIT

        ' get the heading of the requested list
       'strHeadingOfValList = oList.Range.Formula1(1, 1)  ' (typically this line of code does NOT work)
        Set rngList = oList.Range
        strHeadingOfValList = rngList.Formula(1, 1)
        ' compare those two Headings with each other
        If StrComp(strHeadingOfTargetColumn, strHeadingOfValList, vbTextCompare) <> 0 Then GoTo SUB_EXIT

        ' at this point both headings are equal so we've found the correct list used for data validation
        ' check if value of Target appears in this list
        For Each c In rngList
            If StrComp(c.Value, argTarget.Value, vbTextCompare) = 0 Then
                With Application
                    .EnableEvents = False   ' prevent endless loop
                    c.Copy
                    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    .CutCopyMode = False
                    .EnableEvents = True
                End With
                Exit For
            End If
        Next c
    End If
  
SUB_EXIT:
    Set rngHeadingsOnInputSht = Nothing
    Set rngList = Nothing
    Set oList = Nothing
    Set c = Nothing
    Exit Sub
  
NOTHING_TO_DO:
    Err.Clear
    Resume SUB_EXIT
  
SUB_ERROR:
    MsgBox "Something went wrong in this sub; Error Data:" & vbCrLf & _
           "Number: " & Err.Number & vbCrLf & _
           "Source: " & Err.Source & vbCrLf & _
           "Description: " & Err.Description, vbExclamation, "Error message"
    Err.Clear
    Resume SUB_EXIT
End Sub


Public Function GetListObject(ByVal argName As String) As ListObject

    ' Return the list object (as ListObject) based on a given name (as String)
    Dim oWs         As Worksheet
    Dim oLO         As ListObject
    Dim bDone       As Boolean
    For Each oWs In ThisWorkbook.Worksheets
        For Each oLO In oWs.ListObjects
            If StrComp(oLO.Name, argName, vbTextCompare) = 0 Then
                Set GetListObject = oLO
                bDone = True
                Exit For
            End If
        Next oLO
        If bDone Then Exit For
    Next oWs
    Set oLO = Nothing
    Set oWs = Nothing
End Function


Public Function GetNamedRange(ByVal argName As String) As Range

    ' Return the range object (as Range) of a named range by a given name (as String)
    Dim n           As Name
    For Each n In ThisWorkbook.Names
        If StrComp(n.Name, argName, vbTextCompare) = 0 Then
            Set GetNamedRange = n.RefersToRange
            Exit For
        End If
    Next
    Set n = Nothing
End Function

Hello Again @GWteB !

@Akuini Really helped me out on this one but I like your solution too with the Naming Lists part specially because, as you can read on my last answer, I tried to understand how to use the Name Manager this last week for this situation but being new to all this programming excel I didn't understand it as much as I needed to make it work (The most professional use I had made of Excel until now was nested formulas). However, it seems I have the opportunity now to try and understand it with the coding you provided. This solution Akuini helped me with was really what I was looking for to this particular Worksheet but for future applications I want to be more and more fluent, so be sure that I'll write and rewrite over to understand all you've pointed out.

Thanks again for coming back with such a well explained code. I hope I can return the favor someday in this forum to someone else! Have a Great Week!!

 

[Akuini]

Unfortunatelly I still have cells with other stuff after "TOTAL" as you can see below in the Image and checking the last cell with values bottom-up won't make it right

Ok, let's try it by using named ranges.
Note: change "Sheet1" to suit
1. Create a named range "xx" refer to: =Sheet1!$A$11:$A$60
2. Create a named range "yy" refer to: =Sheet1!$AM$2:INDEX(Sheet1!$AM:$AM, COUNTA(Sheet1!$AM:$AM), 1)
3. In cells A11:A60 insert data validation, > List > Source: =yy
4. Then use "xx" in the code :

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.CountLarge <> 1 Then Exit Sub
   If Not Intersect(Target, Range("xx")) Is Nothing Then
   Dim check_row
   check_row = Application.Match(Target.Value, Range("AM:AM"), 0)
        If IsNumeric(check_row) Then
        Target.Interior.Color = Cells(check_row, 39).Interior.Color
        Else
        Target.Interior.Color = xlNone
        End If
    
    End If

End Sub

Note:
1. The named range "xx" will be adjusted automatically when you insert/delete some rows above row 61. Try inserting a row in row 50, you'll see in the Name Manager, the named range "xx" will change to: =Sheet1!$A$11:$A$61
2. Try adding some items in colomn AM, the list in data validation will be adjusted automatically.

 

[Luiz_Wiese]

Ok, let's try it by using named ranges.
Note: change "Sheet1" to suit
1. Create a named range "xx" refer to: =Sheet1!$A$11:$A$60
2. Create a named range "yy" refer to: =Sheet1!$AM$2:INDEX(Sheet1!$AM:$AM, COUNTA(Sheet1!$AM:$AM), 1)
3. In cells A11:A60 insert data validation, > List > Source: =yy
4. Then use "xx" in the code :

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.CountLarge <> 1 Then Exit Sub
   If Not Intersect(Target, Range("xx")) Is Nothing Then
   Dim check_row
   check_row = Application.Match(Target.Value, Range("AM:AM"), 0)
        If IsNumeric(check_row) Then
        Target.Interior.Color = Cells(check_row, 39).Interior.Color
        Else
        Target.Interior.Color = xlNone
        End If
   
    End If

End Sub

Note:
1. The named range "xx" will be adjusted automatically when you insert/delete some rows above row 61. Try inserting a row in row 50, you'll see in the Name Manager, the named range "xx" will change to: =Sheet1!$A$11:$A$61
2. Try adding some items in colomn AM, the list in data validation will be adjusted automatically.

So that's the "Named Lists" fancy huh?... I don't know how to thank enough both @GWteB and @Akuini for the help! Now it's as good as I could imagine. I don't like to make it sound like "Wow, it works like magic" because I know how much time is invested in learning and performing such "magic". This last solution bringing both suggestions together is awesome. You guys are amazing. Thanks again and ahead I go on learning VBA further!!

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.
One thing to consider:
I suggest you move data in column AM ("Projetos") to another sheet, because say if the data reach AM20 and the user insert a row in row 15 then there will be blank row in the data validation list. Or if the user delete the row then the data in that row will be deleted.

 

[GWteB]

So that's the "Named Lists" fancy huh?... I don't know how to thank enough both @GWteB and @Akuini for the help! Now it's as good as I could imagine. I don't like to make it sound like "Wow, it works like magic" because I know how much time is invested in learning and performing such "magic". This last solution bringing both suggestions together is awesome. You guys are amazing. Thanks again and ahead I go on learning VBA further!!

You're welcome & thanks for letting us know.
As I mentioned before my "ancient" code works only on Tables consisting of just one column (back then I even didn't know there was a possibility to define your own dynamic list... ?)
Lots of success with your project!