Find invalid data validation cells - vba

Description:
I have created a custom dropdown data validation list where I can choose among several values. These values on the dropdown list changes as I need (are defined in a worksheet column X).
Problem:
My problem occurs when I choose one of those values, let say Y, from the dropdown list and then I update the data validation by removing the last inserted value (deleted the Y value from column X). By doing this the value Y present in the worksheet is no longer valid so I would like to know if there is a way to obtain a list (array or string) of cells with the invalid data.
What I have done/thought so far:
I have searched in several sites and read similar questions but I cannot find anything usefull. I thought about looping all the cells and check if the value is valid but since I have a huge amount of data I think that it is not the best approach.
Since Excel already mark these invalid data with a red circle maybe it could be possible to get the address of those marked cells?
Thanks in advance!

The correct way to obtain the invalid cells in a worksheet is using Cells.SpecialCells(xlCellTypeAllValidation).
By using some information present in Microsoft KB213773 (Q213773) - "How to create data validation circles for printing in Excel" a similar Sub can be used to loop all invalid cells and then change their values (or mark them to future edit).
Sub CorrectInvalidValues()
Dim data_range As Range
Dim invalid_cell As Range
Dim count As Integer: count = 0
Dim nr_invalid As Integer: nr_invalid = 0
Dim new_value As String
'If an error occurs run the error handler and end the procedure
On Error GoTo errhandler
Set data_range = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
' Loop through each cell that has data validation and gets the number of invalid cells
For Each invalid_cell In data_range
If Not invalid_cell.Validation.Value Then
nr_invalid = nr_invalid + 1
End If
Next
' Editing each value
For Each invalid_cell In data_range
If Not invalid_cell.Validation.Value Then
count = count + 1
Application.Goto reference:=invalid_cell, Scroll:=True
new_value = Application.InputBox("Please insert a correct value.", "Invalid Data " & count & "/" & nr_invalid)
If Not (new_value = "False") Then
invalid_cell.Interior.ColorIndex = 0
invalid_cell.Value = new_value
Else
invalid_cell.Interior.Color = RGB(255, 0, 0)
invalid_cell.Value = "<PLEASE EDIT>"
End If
End If
Next
Exit Sub
errhandler:
MsgBox "There are no cells with data validation on this sheet."
End Sub

Related

Pasting in Data Validation IF the value exists inside the data validation list

A similar question has been asked multiple times, but I have a slightly different ask. I have used some code from superuser that restricts users from pasting values into data validation ranges:
Private Sub Worksheet_Change(ByVal Target As Range)
'Does the validation range still have validation?
If HasValidation(Range("DataValidationRange")) Then
Exit Sub
Else
Application.Undo
MsgBox "Error: You cannot paste data into these cells." & _
"Please use the drop-down to enter data instead.", vbCritical
End If
End Sub
Private Function HasValidation(r) As Boolean
'Returns True if every cell in Range r uses Data Validation
On Error Resume Next
x = r.Validation.Type
If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function
This is great and it works, but I am wondering if it can be taken one step further. The reason users may want to paste into these fields is because they are moving data from one spreadsheet to the other. I have the validation there to ensure the spelling is correct (important for other uses). Is it possible for a user to paste something into the data validation field and it doesn't deny it, based on the code above, IF the value matches something inside the data validation list? Seems ambitious, not sure if it is possible.
Edit: The list is stored in another tab, not hardcoded into the data validation menu
If the Validation isn't Nothing and its type is xlValidateList (underlying value 3), then you can use Validation.Formula1 to get the "list".
That's the easy part.
If Formula1 doesn't start with an = sign, you're looking at a plain comma-separated list of values.
This function gets you a 1-dimensional array with all the valid values of the specified target, regardless of how the data validation list is defined:
Public Function GetValidationValues(ByVal target As Range) As Variant
Dim dataValidation As Validation
Set dataValidation = target.Validation
If dataValidation Is Nothing Then Exit Function
If dataValidation.Type <> xlValidateList Then Exit Function
Dim values As Variant
If Left$(dataValidation.Formula1, 1) <> "=" Then
'plain comma-separated list of values
values = Split(dataValidation.Formula1, ",")
Else
'validation list is a range address, or a named range
Dim rngValues As Range
Set rngValues = Application.Evaluate(dataValidation.Formula1)
If rngValues.Columns.Count > 1 Then
values = Application.Transpose(Application.Transpose(rngValues))
Else
values = Application.Transpose(rngValues)
End If
End If
GetValidationValues = values
End Function
All that's left to do is to determine whether your pasted value is in that array.

Error 1004: Unable to Get CountIf Property

I'm trying to search a range of named cells to see if there are any cells that contain a number greater than zero. Here is the code I currently have:
Dim YTDclauses As Boolean
Dim ytdrng As Range
Set ytdrng = Worksheets("Sheet1").Range("z1AY:z1BB,z1BG:z1BJ")
'Employer 1
If Sheet1.[z1AG] = "No" And WorksheetFunction.CountIf(ytdrng, ">0") = 0 Then
MsgBox "Works!"
Else
MsgBox "Does Not Work"
End If
I'm getting an error back as "Run-time error '1004': Unable to get the CountIfs property of the WorksheetFunction class". By looking at other questions, I think it might be a syntax error with how I'm setting ytdrng, but I've tried many ways of naming it differently to no avail. Any help is appreciated, thank you!
Note: Sheet1 is named "Main Checklist" - I also tried using that in the setting of ytdrng, but got the same error.
As #ScottCraner has stated, you cannot do a countif on a split range. You can modify the routine slightly to implement a countif by looping over each cell in the range:
Dim YTDclauses As Boolean
Dim ytdrng As Range
Dim SRCountif As Long
Dim cel As Object
Set ytdrng = Worksheets("Sheet1").Range("z1AY:z1BB,z1BG:z1BJ")
SRCountif = 0
For Each cel In ytdrng.Cells
If cel.Value > 0 Then SRCountif = SRCountif + 1
Next
'Employer 1
If Sheet1.[z1AG] = "No" And SRCountif = 0 Then
MsgBox "Works!"
Else
MsgBox "Does Not Work"
End If
(The variable SRCountif is meant to mean SplitRangeCountif)
Note that as it is comparing the value to numeric 0, Exec takes any text as greater than 0, so you may want to adjust the test if there is a chance of any text in your range.

VBA Form - Vlookup cell and assign value to that cell

Encountering an issue in a VBA regarding vlookup function.
I have 2 comboboxes and 6 Textboxs for user input.
I want to use a vlookup (or index,Match(),Match()) to look up a cell in a data table and assign the values from the textboxes to these cells.
When I run the code for what I believe should work, it is returning object errors.
Private Sub CommandButton2_Click()
Dim MonthlyTable As Range
Set MonthlyTable = Sheets("DATA Monthly").Range("A6:AE400")
Dim ColumnRef As Range
Set ColumnRef = Sheets("Drivers").Range("N11")
' Assign CB2 value to M11 cell reference so it can be converted to a column ref in N11.
Sheets("Drivers").Range("M11").Value = ComboBox2.Value
Dim CB1Value As String
CB1Value = "Joiners" & ComboBox1.Value
Dim CB2Value As String
CB2Value = ComboBox2.Value
MsgBox CB1Value & " " & CB2Value
Dim tb1value As Range
tb1value = Application.WorksheetFunction.VLookup(CB1Value, MonthlyTable, ColumnRef, False)
tb1value.Value = TextBox1.Value
Unload Me
End Sub
I am at a loss for what to do here as I feel like it should be this simple!
Thanks in advance.
Edit. Further digging indicates that you cannot select a cell you are vlookup'ing as this commands only returns a value it does not actually select the cell for my intents and purposes.
not really clear to me you actual aim, but just following up your desire as stated by:
I want to use a vlookup (or index,Match(),Match()) to look up a cell
in a data table and assign the values from the textboxes to these
cells
you may want to adopt the following technique:
Dim tb1value As Variant '<--| a variant can be assigned the result of Application.Match method and store an error to be properly cheeked for
tb1value = Application.Match(CB1Value, MonthlyTable.Column(1), 0) '<--| try finding an exact match for 'CB1Value' in the first column of your data range
If Not IsError(tblvalue) Then MonthlyTable(tb1value, columnRef.Value).Value = TextBox1.Value '<--| if successful then write 'TextBox1' value in data range cell in the same row of the found match and with `columnRef` range value as its column index
Excel uses worksheet functions to manipulate data, VBA has different tools, and when you find yourself setting cell values on a sheet via VBA so that some worksheet function can refer to them it is time to look for a true VBA solution. I suggest the following which, by the way, you might consider running on the Change event of Cbx2 instead of a command button.
Private Sub Solution_Click()
' 24 Mar 2017
Dim MonthlyTable As Range
Dim Rng As Range
Dim Lookup As String
Dim Done As Boolean
Set MonthlyTable = Sheets("DATA Monthly").Range("A2:AE400")
' take the lookup value from Cbx1
Lookup = ComboBox1.Value
Set Rng = MonthlyTable.Find(Lookup)
If Rng Is Nothing Then
MsgBox Chr(34) & Lookup & """ wasn't found.", vbInformation, "Invalid search"
Else
With ComboBox2
If .ListIndex < 0 Then
MsgBox "Please select a data type.", vbExclamation, "Missing specification"
Else
TextBox1.Value = MonthlyTable.Cells(Rng.Row, .ListIndex + 1)
Done = True
End If
End With
End If
If Done Then Unload Me
End Sub
There are two points that need explanation. First, the form doesn't close after a rejected entry. You would have to add a Cancel button to avoid an unwanted loop where the user can't leave the form until he enters something correct. Note that Done is set to True only when the search criterion was found And a value was returned, and the form isn't closed until Done = True.
Second, observe the use of the ListIndex property of Cbx2. All the items in that Cbx's dropdown are numbered from 0 and up. The ListIndex property tells which item was selected. It is -1 when no selection was made. If you list the captions of your worksheet columns in the dropdown (you might do this automatically when you initialise the form) there will be a direct relationship between the caption selected by the user (such as "Joiners") and the ListIndex. The first column of MonthlyTable will have the ListIndex 0. So you can convert the ListIndex into a column of MonthlyTable by adding 1.
I think it is better to use "find" in excell vba to select a cell instead of using vlookup or other methods.

Excel VBA Macros: Find/Match cells from one sheet to a column in another

Ok, so I have a workbook with multiple sheets. The Worksheets are named:
Inputs
Outputs
Hardware
Input and output are serial IDs matched to actualy IP Addresses.
Input 1 : 192.168.0.1
input 2 : 192.168.0.2
... etc
Hardware has 3 columns. The first has Devices, 2nd column which has the Input Serial IDs and the 3rd of Output Serial IDs.
Toaster : Input 1 : Output 3
Blender : Input 2 : Output 2
...etc
Now, normally, I'd be using Vlookup(A1,Inputs!A:B,2) and Vlookup(A1,Outputs!A:B,2), but I have to incorporate this into the VBA macro we have and I have no idea how.
Sub TrackHardware()
'~~~~~~~~~~~~~~~~~~~~~
'Activating Device
'~~~~~~~~~~~~~~~~~~~~~
currentOutputRow = 2
Dim test As String
For currentRow = 2 To 32768 'The last row of your data
'For Loop to go through contents of Hardware individually
If Not (IsEmpty(Worksheets("Hardware").Range("A" & currentRow).Value)) Then
'To Skip the empty cells
HWID=Worksheets("Hardware").Range("a" & currentvalue).Value
'HWID is the search term coming from Sheet:'Hardware'
Desc=Worksheets("Hardware").Range("D" & currentvalue).Value
'Desc is the Plain Text description coming from Sheet:'Hardware'
inputrow={Match pseudocode that didn't work(HWID, "Inputs", Range:= "A:B", 2) }
outputrow={Match pseudocode that didn't work(HWID, "Outputs", Range:= "A:B", 2) }
'trying to find the row # of search term in Sheets 'Input' and 'Output'
Worksheets("Inputs").Range("C" & inputrow).Value = Desc
Worksheets("Outputs").Range("C" & outputrow).Value = Desc
'Pastes The Device Description to Input and Output Sheets
End If
Next currentRow
'And on to the next line in 'Hardware'
End Sub
I'd also like to account for Errors like 2 devices on the same Input/Output or a Blank cell, but I think I can figure those out myself. This Find function is what's really giving me a lot of trouble.
First, there seems to be a problem if you are not able to call on the Application.Match function. I am not sure why that would be missing, but I know there are some "limited" versions of Office/Excel which do not have full VBA functionality. I am not sure if that is the case with your installation.
Now, on to your problem though...
To use the Application.Match function:
The Match function takes a single row or single column range input. You are attempting to pass in the range "A:B", which will always raise an error. Change to a single row/column range instead.
Further, 2 is not an option for the third argument, which can be either -1 (less than), 0 or False (exact), or 1 (greater than). I'm not sure this alone will raise an error, but you should fix it anyways.
inputRow = Application.Match(HWID, Worksheets("Inputs").Range("A:A"), False)
If an exact match cannot be found, it will raise an error, which you can trap like so:
inputRow = Application.Match(HWID, Worksheets("Inputs").Range("A:A"), False)
If IsError(inputRow) Then
'Do something like:
MsgBox HWID & " not found!", vbInformation
Exit Sub
End If
NOTE If you actually need to check both columns, then you can either double up on the Match function, or use the range .Find method instead.
Dim foundRange as Range
Set foundRange = Range("A:B").Find(HWID)
If Not foundRange Is Nothing Then
inputRow = foundRange.Row
Else
MsgBox HWID & " not found!", vbInformation
End If
Handling errors with WorksheetFunction.Match
Error trapping for Application.WorksheetFunction.Match should be something like:
inputRow = Empty
On Error Resume Next
inputRow = Application.WorksheetFunction.Match(HWID, Worksheets("Inputs").Range("A:A"), False)
If Err.Number <> 0 Then
MsgBox "Match not found", vbInformation
Exit Sub
End If
On Error GoTo 0

Excel VBA: Listbox Error when assigning Linked Cell

I have some cells with Data Validation. Because the dropdown list is small and hard to read, I have a button which opens a list box and populates it with the cell's Data Validation list.
Dim btnAddToList As OLEObject
Public lboTemp As OLEObject
Set btnAddToList = ws.OLEObjects("btnAddToList")
Set lboTemp = ws.OLEObjects("TempListBoxS")
Set Field = Selection ' This is always cell $D$1, $D$2, or $D$3
btnAddToList.Visible = False
'Create a named range "temp"
ActiveWorkbook.Names.Add Name:="temp", RefersTo:=Field.Validation.Formula1
' open list box
' position list box
' load it with "temp"
With lboTemp
'show the listbox with the list
.Visible = True
.Left = Field.Left
.Top = Field.Top + 50
.ListFillRange = "temp"
.Object.MultiSelect = 0 ' Single select
On Error GoTo errHandler
prev = .LinkedCell
If prev <> "" Then prev = prev & ": " & Range(.LinkedCell).Value ' for debugging
.LinkedCell = Field.Address 'SOMETIMES THIS GIVES Err 440: could not set property value, invalid property value
.Width = Field.Width + 5
.Height = WorksheetFunction.Min(270, .Object.ListCount * 20) 'field.Height + 5
End With
As noted in the comment above, I sometimes, but not always, I get an error when the LinkedCell is supposed to be populated by with the Field.Address.
This code is used by six different cells (D1:D3 on two different worksheets), but the error only appears to occur when one of the D1 cells is the one selected. Those cells have one other thing in common: their data validation lists, respectively, are:
='Category Table'!$F$2:$F$31 and
='Category Table'!$F$32:$F$41
The other four cells -- which don't get the error -- use a complicated dynamic range that references a different table on the "Category Table" sheet. (I don't really think this has anything to do with my problem, but I don't see anything else those cells have in common)
If no one can give me an answer, I'd appreciate some advice on how to track down an intermittent problem.
Thanks!
Maybe the problem is the return of Field.Address. The .Adress property returns, by default, with the absolute value of row and column. You can try Field.Address(RowAabsolute:=false, ColumnAbsolute:=false) . Hope this help.
and sorry my english.
I managed to stop this issue by ensuring that the linked cell was empty before creating the reference.