CODEWITHSUNDEEP
excelvba
zigojacko
zigojacko

Reputation: 2063

Extending VB Code to Fill Excel Cells If Column Name Matches Data Validation

We've got some VB code in an Excel Workbook at present which allows data validation (list dropdown) options to be multiple selected and then for each dropdown item selected from the list, it outputs the option at the end of the row, one option per column.

I.e: Selecting Apples, Bananas and Cherries from the drop down list would output Apples | Bananas | Cherries (where | is column separator) at the end of the row where the first cells are empty.

The code we have for this is:-

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exitHandler

Dim rngDV As Range
Dim iCol As Integer

If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
   If Target.Column = 3 Then
    If Target.Value = "" Then GoTo exitHandler
    If Target.Validation.Value = True Then
     iCol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 1
     Cells(Target.Row, iCol).Value = Target.Value
   Else
     MsgBox "Invalid entry"
     Target.Activate
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True

End Sub

What we would like to modify in this VB code however, is instead of filling cells at the end of the row with the data validations selected. We would like to fill the cell under the column where column heading matches the option selected from dropdown.

I.e: Apples selected in dropdown would fill the cell on that row under the column labelled 'Apples'. Cherries selected in dropdown would fill the cell on that row under the column labelled 'Cherries'. Ideally, by fill, we would colour that cell or put an X there rather than repeat the name of the item selected.

If anyone could advise on what we would need to modify in the above code, it would be greatly appreciated.

Upvotes: 0

Views: 3109

Answers (2)

Ross McConeghy
Ross McConeghy

Reputation: 874

I have modified your code to do as you requested, it iterates through the column headers to find the correct column then changes the background color of the appropriate cell.
UPDATE: Added a check to prevent an infinite loop.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exitHandler

Dim rngDV As Range
Dim iCol As Integer, iColumnHeaderRow As Integer
iColumnHeaderRow = 3 'change this if header row changes

If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Not Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    If Target.Column = 3 Then
        If Target.Value = "" Then GoTo exitHandler
        If Target.Validation.Value = True Then
            'iterate through column headers to find the matching column
            iCol = (Target.Column + 1)
            Do Until Cells(iColumnHeaderRow, iCol).Value = Target.Value
                iCol = iCol + 1
                'if we've hit a blank cell in the header row, exit 
                '(also to prevent an infinite loop here)
                If Cells(iColumnHeaderRow, iCol).Value = "" Then GoTo exitHandler
            Loop

            'set fill color of appropriate cell
            With Cells(Target.Row, iCol).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
        Else
            MsgBox "Invalid entry"
            Target.Activate
        End If
    End If
End If

exitHandler:
    Application.EnableEvents = True
End Sub

Upvotes: 1

Daniel Möller
Daniel Möller

Reputation: 86650

Substitute 

Cells(Target.Row, iCol).Value = Target.Value

for 

Cells(Target.Row, Range(Target.Value).Column).Value = "X"

Beware: it will only work if you name the header cells. The Range("Banana") for example, will refer to the cell you gave the name "Banana".

To give names, use the textbox in the top left of the screen. That textbox originally contains just the cell coordinates, like "A1", "B2", or so. Click the header cell you want to name, go to this text box and type "Banana" or any other name that matches your dropdown values. Name all your headers with all dropdown values (a missing one would cause errors).

(And you can abandon that iCol calculation)

Upvotes: 1

Related Questions