Microsoft Office Forums - View Single Post

excelledsoftware · 05-31-2015, 07:25 PM

Ok here is what I was able to put together quickly. Now I have the filter actually hiding the rows rather than filtering it. This is slightly different. In the event you need to actually apply the filter I would advise having a column get a value like a 1 in column DQ then apply the filter to DQ.

Code:

Option Explicit

Sub CheckYesValues()
  'Looks at each header in sheet 3 and then identifies if it has a yes.
  'If it does the value is placed into the resultrow.
  Dim wb As Workbook, cws As Worksheet, CheckRow As Long, ResultRow As Long
  Dim Header As String, CheckCol As Integer, LastCol As Integer, LastRow As Long
  Dim Code As String, CheckString As String, rws As Worksheet
  Dim FilterString As String, FilterGroup As Variant, v As Variant
  
  
  'Set the references
  Set wb = ThisWorkbook
  Set cws = wb.Worksheets("Sheet3")
  Set rws = wb.Worksheets("Sheet1")
  LastCol = cws.Range("A1").End(xlToRight).Column
  LastRow = 11 'Hard coded for now
  ResultRow = 14
  
  
  'Perform the checks and print results
  For CheckCol = 3 To LastCol
    Header = cws.Cells(1, CheckCol).Value
    For CheckRow = 2 To LastRow
      Code = cws.Range("A" & CheckRow).Value
      CheckString = LCase(cws.Cells(CheckRow, CheckCol).Value)
      If CheckString = "yes" Then 'print result
        cws.Range("A" & ResultRow).Value = Header
        cws.Range("B" & ResultRow).Value = Code + 0
        ResultRow = ResultRow + 1
      End If
    Next CheckRow
  Next CheckCol
  
  'Hold the values in a string to check
  For CheckRow = 14 To ResultRow - 1 ' Again hardcoded for now
    CheckString = cws.Range("C" & CheckRow).Value
    If InStr(1, FilterString, CheckString) = 0 Then
      FilterString = FilterString & CheckString & ","
    End If
    CheckString = cws.Range("D" & CheckRow).Value
    If InStr(1, FilterString, CheckString) = 0 Then
      FilterString = FilterString & CheckString & ","
    End If
  Next CheckRow
  'Remove final comma
  If Right(FilterString, 1) = "," Then
    FilterString = Mid(FilterString, 1, Len(FilterString) - 1)
  End If
  'Split into array to use
  FilterGroup = Split(FilterString, ",")
   
  '****************************************
  'Now do the 2nd part of the macro
  LastRow = rws.Range("B1").End(xlDown).Row + 1
  'Make sure all are showing first
  For CheckRow = 2 To LastRow
    If rws.Range("A" & CheckRow).EntireRow.Hidden = True Then
      rws.Range("A" & CheckRow).EntireRow.Hidden = False
    End If
  Next CheckRow
  
  'Now check
  For CheckRow = 2 To LastRow
    CheckString = rws.Range("P" & CheckRow).Value
    'Check if its in there
    For Each v In FilterGroup
      If InStr(1, CheckString, v) Then
        rws.Range("A" & CheckRow).EntireRow.Hidden = True
        Exit For
      End If
    Next v
  Next CheckRow
  
  MsgBox "done"
  
End Sub

As with all code, backup your work and save before running.

Let me know if this is a good starting point, the solution or if you need anything else.

Thanks