Hello all,
I'm working on a macro that checks if list validation rule is applied to a cell and if it is empty, fill its content from one of the values available in the list.
I'm currently facing a problem that the setting of up of value is applied even if there is no list validation rule applied to it.
My sample data in a worksheet
Header
List validation rule Applied but empty
List validation rule Applied but empty
List validation rule Applied but empty
.
.
.
Header
List validation rule Applied but empty
List validation rule Applied but empty
List validation rule Applied but not empty
.
.
.
Header
List validation rule Applied but empty
List validation rule Applied but empty
List validation rule Applied but empty
.
.
.
The problem is even though list validation rule is not applied to headers, the value is applied to them. I would like to know a way to stop this.
Sub FillDefaults()
'Open the selected workbooks and apply default values
Dim currentSheet As Worksheet
Dim cellRange As Range
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Show
.Filters.Add "Excel 2003", "*.xls"
.Filters.Add "Excel 2007", "*.xlsx"
For counter = 1 To .SelectedItems.Count
Workbooks.Open (.SelectedItems(counter))
For Each currentSheet In ActiveWorkbook.Sheets
'For every sheet, start from the cell with first test condition
'If the cell is a test condition and a validation rule applied
'then make the default choice to its status
Dim cellCounter As Integer
Dim cellValue As Variant
Dim Rng As Range
cellCounter = 2
cellValue = currentSheet.Range("A" & cellCounter).Value
Do While cellValue <> ""
'check if corrsponding test conditions's status has any
'list validation applied and apply default values
On Error Resume Next
Set Rng = Intersect(currentSheet.Range("B" & cellCounter), Cells.SpecialCells(xlCellTypeSameValidation))
On Error GoTo 0
If Rng Is Nothing Then
If currentSheet.Range("B" & cellCounter).Value = "" Then
currentSheet.Range("B" & cellCounter).Value = "In Progress"
End If
End If
cellCounter = cellCounter + 1
cellValue = currentSheet.Range("A" & cellCounter).Value
Loop
Next
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
End With
End Sub
Bookmarks