@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:
VBA Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Call CopyCellFormatFromTable_TO_CellWithDataValidation(Target)
End Sub
Regular Module:
VBA Code:
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
). 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.
