Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 05-31-2015, 07:25 PM
excelledsoftware excelledsoftware is offline Process Automation Windows 8 Process Automation Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

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
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Process Automation Outlook process not closing 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
Process Automation Excel -> PowerPoint multiple presentations - process automation 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

Other Forums: Access Forums

All times are GMT -7. The time now is 05:46 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft