[mso] Re: Excel filter

The macro below will list, on a new sheet, every cell on the active worksheet 
which has data validation. It also lists the general type of validation (whole 
number, date, list, etc.)
   
  Option Explicit
   
  Public Sub ListDataVal()
'On a new sheet, lists all data validation on the active sheet by cell.
    Dim x As Long, Rng As Range, Hits As Long
    Dim DVT As Integer, Descr As String
    Dim NewWS As Worksheet, StartWS As Worksheet
    Dim LastCell As String, msg1 As String
    Hits& = 1
    Set StartWS = ActiveSheet
'Add a new worksheet to the current workbook at the end.
    Worksheets.Add.Move after:=Sheets(Sheets.Count)
    Set NewWS = ActiveSheet
    StartWS.Activate
'Select the UsedRange.
    ActiveSheet.UsedRange.Select
    For Each Rng In Selection
'Check the type of data validation, if any.
        DVT% = DataValType(Rng)
        Select Case DVT%
            Case 1:
                Descr$ = "Whole number"
            Case 2:
                Descr$ = "Decimal number"
            Case 3:
                Descr$ = "List"
            Case 4:
                Descr$ = "Date"
            Case 5:
                Descr$ = "Time"
            Case 6:
                Descr$ = "Text length"
            Case 7:
                Descr$ = "Custom"
            Case Else
                'do nothing
        End Select
        If DVT% > 0 Then
            Hits& = Hits& + 1
            NewWS.Cells(Hits&, 1).Value = "'" & StartWS.Name
            NewWS.Cells(Hits&, 2).Value = "'" & Rng.Address
            NewWS.Cells(Hits&, 3).Value = "'" & Descr$
        End If
    Next Rng
'If no cells were found, tell user & delete the new sheet.
    If Hits& = 1 Then
        MsgBox "No cells with data validation were found", _
            vbInformation, "ListDataVal"
        Application.DisplayAlerts = False
        NewWS.Delete
        Application.DisplayAlerts = True
        GoTo Cleanup1
    End If
'Add headings for the output rows.
    NewWS.Cells(1, 1).Value = "Sheet"
    NewWS.Cells(1, 2).Value = "Cell"
    NewWS.Cells(1, 3).Value = "Type"
    With NewWS.Range("A1:C1").Font
        .Bold = True
        .Underline = xlUnderlineStyleSingle
    End With
'Resize all columns on NewWS.
    NewWS.Activate
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Activate
Cleanup1:
    StartWS.Activate
    Range("A1").Activate
'Free object variables.
    Set NewWS = Nothing
    Set StartWS = Nothing
'Restore the cursor.
    Application.Cursor = xlDefault
    Exit Sub
LDVerr1:
    If Err.Number <> 0 Then
        msg1$ = "Error # " & Str(Err.Number) & _
                " was generated by " & Err.Source & _
                Chr(13) & Err.Description
        MsgBox msg1$, , "ListDataVal"
    End If
    GoTo Cleanup1
End Sub
   
  Public Function DataValType(Rng As Range) As Integer
    On Error GoTo DVTerr1
'Return data validation type for this cell.
    DataValType% = Rng.Validation.Type
    Exit Function
DVTerr1:
'Return zero if no data validation for this cell.
    DataValType% = 0
End Function
  Hope this helps,
   
  Hutch
  
"Spark ." <spaaark@xxxxxxxxx> wrote:
  Is there any way where we can identify filters or validations applied to the
excel sheet, without actually going manually visiting to each cell. We can
view filters applied, but we can't view validations applied, for that we
need to visit the cells or columns and needs to check it.
So is there any way where we can check, it would be great help me.
Thanks in advance.
Spark


*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or 
MicrosoftOffice@xxxxxxxxxxxxxxxx

To send mail to the group, simply address it to mso@xxxxxxxxxxxxx

To Unsubscribe from this group, visit the group's homepage and use the dropdown 
menu at the top. This will allow you to unsubscribe your email address or 
change your email settings to digest or vacation (no mail).
http://www.freelists.org/webpage/mso

To be able to share files with the group, you must join our Yahoo sister group. 
This group will not allow for posting of emails, but will allow you to join and 
share problem files, templates, etc.: 
http://tech.groups.yahoo.com/group/MicrosoftOffice . This group is for FILE 
SHARING ONLY.

If you are using Outlook and you see a lot of unnecessary code in your email 
messages, read these instructions that explain why and how to fix it:
http://personal-computer-tutor.com/abc3/v28/greg28.htm
*************************************************************


       
---------------------------------
Need a vacation? Get great deals to amazing places on Yahoo! Travel. 

*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or 
MicrosoftOffice@xxxxxxxxxxxxxxxx

To send mail to the group, simply address it to mso@xxxxxxxxxxxxx

To Unsubscribe from this group, visit the group's homepage and use the dropdown 
menu at the top.  This will allow you to unsubscribe your email address or 
change your email settings to digest or vacation (no mail).
http://www.freelists.org/webpage/mso

To be able to share files with the group, you must join our Yahoo sister group. 
 This group will not allow for posting of emails, but will allow you to join 
and share problem files, templates, etc.:  
http://tech.groups.yahoo.com/group/MicrosoftOffice . This group is for FILE 
SHARING ONLY.

If you are using Outlook and you see a lot of unnecessary code in your email 
messages, read these instructions that explain why and how to fix it:
http://personal-computer-tutor.com/abc3/v28/greg28.htm
*************************************************************

Other related posts: