find values under 20% across worksheets and list said worksheets

adamprocter

Board Regular
Joined
Apr 13, 2015
Messages
53
I would like my Macro to go into all works sheets and look at the last row of I matching todays date and if this value is under 20% then to paste the name of that worksheet back into the master worksheet allowing a quick overview of under performing data.

I think I have got the selection process right but am not sure on pasting back into main worksheet and at the moment I get undefined error for .Rows ?!
Any help much appriciated

Code:
Sub PerformanceMacro()
 
    
    Dim SheetName As Worksheet
    Dim ws1 As Worksheet
    Dim rcMatch As Variant
    Dim LastRow As Long
    
    Set ws1 = ThisWorkbook.Worksheets("Execution Screen (login)")
    
    For Each SheetName In Worksheets
             
                LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
                          rcMatch = Application.Match(CLng(Date), .Range("A1:A" & LastRow), 0)
                If IsNumeric(rcMatch) < "20.00" Then
                    'Paste into ws1 worksheet into Col o rows 6/8/10/12 forever the name of worksheert any that are under 20%
                End If
           
          
    Next SheetName

End Sub
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,493
Office Version
365, 2010
Platform
Windows
Does this work for you... (Clear your errors)

Code:
Sub PerformanceMacro()
 
    
    Dim SheetName As Worksheet
    Dim ws1 As Worksheet
    Dim rcMatch As Variant
    Dim LastRow As Long
    
    Set ws1 = ThisWorkbook.Worksheets("Execution Screen (login)")
    
    For Each SheetName In Worksheets
                With SheetName
                LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
                          rcMatch = Application.Match(CLng(Date), .Range("A1:A" & LastRow), 0)
                End With
                If IsNumeric(rcMatch) < "20.00" Then
                    'Paste into ws1 worksheet into Col o rows 6/8/10/12 forever the name of worksheert any that are under 20%
                End If
           
          
    Next SheetName

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,099,335
Messages
5,468,003
Members
406,563
Latest member
kdorClintR

This Week's Hot Topics

Top