![]() |
#8
|
|||
|
|||
![]()
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 Let me know if this is a good starting point, the solution or if you need anything else. Thanks |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Alan.bailey | Outlook | 2 | 02-12-2015 08:56 AM |
Automation Process of Schedule Report Output and Report Check Score Card ! | ozman86 | Word VBA | 1 | 11-19-2014 11:52 PM |
![]() |
wstach | Excel Programming | 2 | 03-18-2014 06:20 AM |
automating a repetitive process | vthomeschoolmom | Excel Programming | 1 | 02-28-2012 07:41 PM |
Automating daily process | dreww2 | Outlook | 0 | 06-28-2011 07:25 PM |