Extract top 5 rows, not colored or greyed out

[x65140]

Need to extract the top 5 rows from SHEET2 to put on SHEET1.
Just extract the BOLD/BLACK fonted rows - not the BLUE/YELLOW and not the GREYED OUT

This also needs to update as the list updates. The list will change a name to greyed out, so the top 5 will need to change without that name.

see attached

[maras_mak]

If I understood you correctly, paste the code into the normal VBA module and run it.

Sub NotBlueGrey_maras_mak() 
    Dim rng As Range, cell_ As Range 
    Dim i As Integer, ii As Integer 
    Dim a, rws 
     
    With Sheets("Sheet2").[B3] 
        Set rng = .CurrentRegion.Columns(1) 
        a = .CurrentRegion.Value 
        ReDim rws(1 To UBound(a)) 
    End With 
     
    For i = 1 To UBound(a) 
        If rng.Cells(i).Font.Color = vbBlack Then 
            ii = ii + 1 
            rws(ii) = rng.Cells(i).Row - 2 
            If ii = 5 Then Exit For 
        End If 
    Next 
 
    ReDim Preserve rws(1 To ii) 
    With Sheets("Sheet1").[Q3] 
        .CurrentRegion.ClearContents 
        .Resize(ii, 4) = Application.Index(a, Application.Transpose(rws), Array(1, 2, 3, 4)) 
    End With 
    Set rng = Nothing 
End Sub  

[Ton(at)FINQuality]

Hope this helps:

Please Login or Register  to view this content.