grid me

[Trevor3007]

Hi,

I am on a works rota & would like to run VB so each month when the rota comes out , I can place a 'grid' (double outside / thick line & line colour red) it will find my name and do this for me. The reason it must use me name , is becasue it depends of the number of other staff who are on the list too ( for example, july 22, I am in row 14, but in august22 I am now in row 35)
22
All the names start in col E:EJ.

I hope this maked sense...thank you

 

[Logit]

" All the names start in col E:EJ. "

Will your name always be located in Col E ? Or will it be located in any Column from E to EJ ?

 

[Trevor3007]

" All the names start in col E:EJ. "

Will your name always be located in Col E ? Or will it be located in any Column from E to EJ ?

Thanks Logit,

Silly me, the names will always be in Col E ( first name starts in E5)

 

[Alex Blakenburg]

See if this works for you. You will have to change findName to the name you want hightlighted.

Sub TestHightlight()

    Dim sht As Worksheet
    Dim rng As Range, rngFound As Range
    Dim findName As String
    Dim BorderType As Variant
    
    findName = "Alice"              ' <--- Enter name to highlight
    Set sht = ActiveSheet
    With sht
        Set rng = .Range(.Cells(5, "E"), .Cells(Rows.Count, "E").End(xlUp))
    End With

    For Each BorderType In Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom, xlInsideHorizontal)
        With rng
            .Borders(BorderType).LineStyle = xlNone
        End With
    Next BorderType
    
    Set rngFound = rng.Find(What:=findName, After:=rng.Cells(1, 1), LookIn:=xlFormulas2, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
    If Not rngFound Is Nothing Then
        For Each BorderType In Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)
            With rngFound.Borders(BorderType)
                 .LineStyle = xlContinuous
                 .Color = vbRed
                 .TintAndShade = 0
                 .Weight = xlThick
             End With
        Next BorderType
    Else
        MsgBox "Name not found"
    End If
    

End Sub

 

[Trevor3007]

See if this works for you. You will have to change findName to the name you want hightlighted.

Sub TestHightlight()

    Dim sht As Worksheet
    Dim rng As Range, rngFound As Range
    Dim findName As String
    Dim BorderType As Variant
   
    findName = "Alice"              ' <--- Enter name to highlight
    Set sht = ActiveSheet
    With sht
        Set rng = .Range(.Cells(5, "E"), .Cells(Rows.Count, "E").End(xlUp))
    End With

    For Each BorderType In Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom, xlInsideHorizontal)
        With rng
            .Borders(BorderType).LineStyle = xlNone
        End With
    Next BorderType
   
    Set rngFound = rng.Find(What:=findName, After:=rng.Cells(1, 1), LookIn:=xlFormulas2, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
    If Not rngFound Is Nothing Then
        For Each BorderType In Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)
            With rngFound.Borders(BorderType)
                 .LineStyle = xlContinuous
                 .Color = vbRed
                 .TintAndShade = 0
                 .Weight = xlThick
             End With
        Next BorderType
    Else
        MsgBox "Name not found"
    End If
   

End Sub

great ..thank you.
but oh...I should of stated (my fault) that I wanted to 'grid all the cells to the right of my name ( number of cells wil be no more than 31 ..as this would be the 'last day of a 31 month)

Again my apologees for not includung this, I am very very gratful for you help.

thanks again

 

[Alex Blakenburg]

Do you want individual boxes or only big box - see below ?
Do you want to lock in the 31 cells (+ Name) or do you want me to use a spefic row to work out how many columns and if so which row is the heading row that can be used to work out how many columns ?

 

[Trevor3007]

Hi

in answer to to your previuos

individual boxes

use a spefic row to work out how many columns The heading row is E5

thank you Alex :}

 

[Alex Blakenburg]

Give this a try.

Sub TestHightlight()

    Dim sht As Worksheet
    Dim rng As Range, rngFound As Range
    Dim findName As String
    Dim BorderType As Variant
    Dim rowLast As Long, colLast As Long
    
    findName = "Trevor"              ' <--- Enter name to highlight
    Set sht = ActiveSheet
    With sht
        rowLast = .Cells(Rows.Count, "E").End(xlUp).Row
        colLast = .Cells(5, Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(5, "E"), .Cells(rowLast, colLast))
    End With

    For Each BorderType In Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom, _
                                    xlInsideHorizontal, xlInsideVertical)
        With rng.Resize(, 32)                           ' Use days 31 + Name column for clearing previous formatting
            .Borders(BorderType).LineStyle = xlNone
        End With
    Next BorderType
    
    Set rngFound = rng.Columns(1).Find(What:=findName, After:=rng.Cells(1, 1), LookIn:=xlFormulas2, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
    If Not rngFound Is Nothing Then
        For Each BorderType In Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom, _
                                    xlInsideVertical)
            With rngFound.Resize(1, rng.Columns.Count).Borders(BorderType)
                 .LineStyle = xlContinuous
                 .Color = vbRed
                 .TintAndShade = 0
                 .Weight = xlThick
             End With
        Next BorderType
    Else
        MsgBox "Name not found"
    End If
    
End Sub

 

[Trevor3007]

Hi Alex,

My bad... it works , as you can see from the screenshot below, it over shoots

i do hope you can sort. Many thanks again.

 

[Alex Blakenburg]

There are few ways to do this, see if this works for you.
If where you have Oct on row 3 you have an actual date showing both month and year, that would be more reliable and I could use that.
Without the year the code would not be able to work out if Feb was in a leap year or not.

Replace this line:

        colLast = .Cells(5, Columns.Count).End(xlToLeft).Column

With these 2 lines

        colLast = .Cells(4, "E").End(xlToRight).Column
        If .Cells(4, colLast) = "Holiday" Then colLast = colLast - 1        ' In case the gap befor the Holiday column is removed