I hope to display only rows containing the word "Total" in the attached sheet.

[mstone2112]

I have seen threads with a similar request but I'm afraid I don't know how to make the appropriate substitutions. The attached file shows a report that I run frequently to assess resource loading. I hope to show only the rows containing the word "Total". Is there a macro I can use?

MS2112

[Mumps1]

Try:

Sub Test()
    Application.ScreenUpdating = False
    Dim bottomC As Integer
    bottomC = Sheets("Page1-1").Range("C" & Rows.Count).End(xlUp).Row
    Dim c As Range
    For Each c In Sheets("Page1-1").Range("C5:C" & bottomC)
        If c <> "Total" Then
            c.EntireRow.Hidden = True
        End If
    Next c
    Application.ScreenUpdating = True
End Sub

[mstone2112]

Thank you so much for the quick reply. I'm afraid I may be doing something wrong with the application of the macro and I'm not sure I understand how to work with the Criteria window. I tried selecting the cell containing the value "Total" (AD2) but it didn't work. Am I doing something wrong?

[jaslake]

Hi MS2112

This Code uses AutoFilter to do as you describe

Option Explicit

Sub Filter_Total()

    Dim LR As Long
    Dim Ws As Worksheet

    Set Ws = Sheets("Page1-1")

    With Ws
        .Range("C4").Value = "X"
        LR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        .Range("A4:C4").AutoFilter
        .Range("A4:C" & LR).AutoFilter Field:=3, Criteria1:="Total"
    End With
End Sub

[mstone2112]

That works perfectly! Thank you so much.

[jaslake]

Hi MS2112

You're welcome...glad I could help.

If this resolves your issue please mark your Thread as SOLVED.

New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:
How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save

[mstone2112]

John:

Sorry for the slow response. I have marked the issue as SOLVED. Thank you very much.

I hope to do more with the data but don't want to cross a line of requesting too much so please tell me if my request is unreasonable.

I hope to take the consolidated data and total it by department each week, then show each of the departments on a line graph. I would also like to show the individual totals separately as percentages of a 40-hour capacity (perhaps on a table like the original). Both charts will be used to project available bandwidth for a resource (and a department) in the weeks to come. I will do this manually but as I will need to repeat this on a regular basis based on the same core report, it will be wonderful if anyone can provide assistance with pieces of this so I can streamline the process.

Sincerely,

Mike

[jaslake]

Hi Mike

Regarding this

don't want to cross a line of requesting too much

The new issues you describe are beyond the scope of this Thread and perhaps should be the subject of a new Thread.

I can't envision what you're describing so you may wish to attach a sample of your expected output to your new Thread. I notice you're using Merged Cells in your file...this could possibly create issues...best of luck.

[downtown1933]

Will this work?

[mstone2112]

Thank you for replying. Actually my goal was to show only the totals rather than hiding them. Jaslake's macro works perfectly. I may be able to make use of your macro in some other cases. I do appreciate it.

[downtown1933]

Oh sorry I misread your post. I will go ahead and post this one as another option, because i recently posted it for someone else, and it is probably the macro i use more frequently than anyother. IT will create a new page, returning all occurrences of your seaRch. It will also add hyperlinks with cell addresses for each occurrence.

Option Compare Text
Option Explicit

Public Sub DoFindAll()
    FindAll "", "True"
End Sub

Sub FindAll(Search As String, Reset As Boolean)

Dim WB              As Workbook
Dim WS              As Worksheet
Dim Cell            As Range
Dim Prompt          As String
Dim Title           As String
Dim FindCell()      As String
Dim FindSheet()     As String
Dim FindWorkBook()  As String
Dim FindPath()      As String
Dim FindText()      As String
Dim Counter         As Long
Dim FirstAddress    As String
Dim path            As String
  
    If Search = "" Then
        Prompt = "What dates do you want to search for in the worbook: " & _
            vbNewLine & vbNewLine & path
        Title = "Date Search"
        Search = InputBox(Prompt, Title, "Date ranges to search for:")
        If Search = "" Then
            GoTo Cancelled
        End If
    End If
    
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    On Error GoTo Cancelled
    
    Set WB = ActiveWorkbook
    For Each WS In WB.Worksheets
        If WS.Name <> "Date Results Search" Then

            With WB.Sheets(WS.Name).Range("A:Z")
    
                Set Cell = .Find(What:=Search, LookIn:=xlValues, LookAt:=xlPart, _
                    MatchCase:=False, SearchOrder:=xlByColumns)
                If Not Cell Is Nothing Then
                    FirstAddress = Cell.Address
                    Do
                        Counter = Counter + 1
                        ReDim Preserve FindCell(1 To Counter)
                        ReDim Preserve FindSheet(1 To Counter)
                        ReDim Preserve FindWorkBook(1 To Counter)
                        ReDim Preserve FindPath(1 To Counter)
                        ReDim Preserve FindText(1 To Counter)
                        FindCell(Counter) = Cell.Address(False, False)
                        FindText(Counter) = Cell.Text
                        FindSheet(Counter) = WS.Name
                        FindWorkBook(Counter) = WB.Name
                        FindPath(Counter) = WB.FullName
                        Set Cell = .FindNext(Cell)
                    Loop While Not Cell Is Nothing And Cell.Address <> FirstAddress
                End If
            End With
        End If
    Next

    If Counter = 0 Then
        MsgBox Search & " was not found.", vbInformation, "Zero Dates found"
        GoTo Cancelled
    End If
    On Error Resume Next
    Sheets("Date Results Search").Select
    If Err <> 0 Then
        ThisWorkbook.Sheets("Date Results Search").Copy Before:=ActiveWorkbook.Worksheets(1)
    End If

Dim wsTest As Worksheet
Const strSheetName As String = "Date Results Search"
 
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If

    On Error GoTo Cancelled

    Range("A3", ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
    Range("A1:B1").Interior.ColorIndex = 35
    Range("A1").Value = "All Occurances of    :"
    If Reset = True Then Range("B1").Value = Search
    Range("A1:D2").Font.Bold = True
    Range("A2").Value = "LINK TO RESULTS"
    Range("B2").Value = "RESULTS"
    Range("A1:B1").HorizontalAlignment = xlLeft
    Range("A2:B2").HorizontalAlignment = xlCenter
    With Columns("A:A")
        .ColumnWidth = 14
        .VerticalAlignment = xlTop
    End With
    With Columns("B:B")
        .ColumnWidth = 50
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
    For Counter = 1 To UBound(FindCell)
    ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & Counter + 2), _
        Address:="", SubAddress:="'" & FindSheet(Counter) & "'" & "!" & FindCell(Counter), _
        TextToDisplay:=FindSheet(Counter) & " - " & FindCell(Counter)
        Range("B" & Counter + 2).Value = FindText(Counter)
        

        Range("C" & Counter + 2).Value = _
            Sheets(FindSheet(Counter)).Range(FindCell(Counter)).Offset(0, 1)
        Range("D" & Counter + 2).Value = _
            Sheets(FindSheet(Counter)).Range(FindCell(Counter)).Offset(0, 2)

        
        '*********************************************
    Next Counter
    
    'Find search term and colour text
    ColourText

Cancelled:

    Set WB = Nothing
    Set WS = Nothing
    Set Cell = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub

Sub ColourText()
    Dim Strt As Long, x As Long, i As Long
    Columns("B:B").Characters.Font.ColorIndex = xlAutomatic
    For i = 3 To Range("B" & Rows.Count).End(xlUp).Row
        x = 1
        Do
            Strt = InStr(x, Range("B" & i), [B1], 1)
            If Strt = 0 Then Exit Do
            Range("B" & i).Characters(Start:=Strt, _
                Length:=Len([B1])).Font.ColorIndex = 7
            x = Strt + 1
        Loop
    Next
End Sub

[mstone2112]

John:

I posted my examples in a thread entitled "I hope to convert a table from values to % of a 40-hour capacity and graph dept totals". Please let me know if I have omitted anything. Again, if the request is unreasonable, please let me know.

Mike