Data Validation circle cell position
Hi everyone.
I want to create an alert that flashes a msgbox when a sheet is activated and contains data that is flagged as invalid by using the validation circles. In a large sheet, it is tricky to find all the cells that may contain invalid data which is why I want to be able to create a msgbox that lists the addresses or something like that. By looping through the shapes in the sheet, I can determine that these errors exist but I can't find out where they are as the data validation oval does not appear to have a .topleftcell location. I can find out where it is in absolute terms - ..top and .left. etc.. How do I reverse engineer screen position to a cell address? Sub shaper() Dim shp As Shape Dim x As Long Dim s_addr As String For Each shp In ActiveSheet.Shapes If shp.Type = 1 Then ' oval x = x + 1 s_addr = _ Cells(shp.TopLeftCell.Row, shp.TopLeftCell.Column).Address ' fails on type 1 Debug.Print shp.Type & " - "; shp.Name & " - " & s_addr End If Next shp If x < 0 Then MsgBox "Sheet contains " & x & " Data Validation Errors." End Sub Help always appreciated! Many thanks! Robert -- Rodels! Creating wonderful weapons of Maths Destruction since 1998! |
Data Validation circle cell position
Hi Rodels,
I want to create an alert that flashes a msgbox when a sheet is activated and contains data that is flagged as invalid by using the validation circles. In a large sheet, it is tricky to find all the cells that may contain invalid data which is why I want to be able to create a msgbox that lists the addresses or something like that. By looping through the shapes in the sheet, I can determine that these errors exist but I can't find out where they are as the data validation oval does not appear to have a .topleftcell location. I'd use a different approach altogether: Sub FindViolations() Dim oRng As Range Dim oCell As Range Dim oInvalid As Range On Error Resume Next Set oRng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllVa lidation) On Error GoTo 0 If oRng Is Nothing Then Exit Sub For Each oCell In oRng If oCell.Validation.Value = False Then If oInvalid Is Nothing Then Set oInvalid = oCell Else Set oInvalid = Union(oInvalid, oCell) End If End If Next If Not oInvalid Is Nothing Then oInvalid.Select MsgBox "Validations violated in cells: " & oInvalid.Address Else MsgBox "No validations violated" End If End Sub Regards, Jan Karel Pieterse Excel MVP http://www.jkp-ads.com |
Data Validation circle cell position
Hi jan Karel,
Brilliant as always! Many thanks! Kind Regards, Robert -- Rodels! Creating wonderful weapons of Maths Destruction since 1998! "Jan Karel Pieterse" wrote: Hi Rodels, I want to create an alert that flashes a msgbox when a sheet is activated and contains data that is flagged as invalid by using the validation circles. In a large sheet, it is tricky to find all the cells that may contain invalid data which is why I want to be able to create a msgbox that lists the addresses or something like that. By looping through the shapes in the sheet, I can determine that these errors exist but I can't find out where they are as the data validation oval does not appear to have a .topleftcell location. I'd use a different approach altogether: Sub FindViolations() Dim oRng As Range Dim oCell As Range Dim oInvalid As Range On Error Resume Next Set oRng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllVa lidation) On Error GoTo 0 If oRng Is Nothing Then Exit Sub For Each oCell In oRng If oCell.Validation.Value = False Then If oInvalid Is Nothing Then Set oInvalid = oCell Else Set oInvalid = Union(oInvalid, oCell) End If End If Next If Not oInvalid Is Nothing Then oInvalid.Select MsgBox "Validations violated in cells: " & oInvalid.Address Else MsgBox "No validations violated" End If End Sub Regards, Jan Karel Pieterse Excel MVP http://www.jkp-ads.com . |
Data Validation circle cell position
Hi Rodels,
Many thanks! You're welcome. Regards, Jan Karel Pieterse Excel MVP http://www.jkp-ads.com |
All times are GMT +1. The time now is 11:27 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com