Populating 1, 2, or 3 cells to the left with text of any cell that contains a specific value (test also)

[MarkRandall]

Hi all,

hoping to get some help with this.

I am establishing an availability table in Excel. I have dates listed by day across the top of the spreadsheet and people listed down the left. In the table I have the date that the individuals arrives on shift marked as AR and the day that they leave shift as DP.

I would like to use some excel magic to populate the three cells to the immediate left of the cells that contain AR with the text TRG (to indicate that they are available to attend training). Once this is done, I can filter by dates to see who is available across the entire company.

Then i would like to do the same to indicate that an individual is available for training for the 3 days after they depart (DP)

Small mock up below

	Tue	Wed	Thu	Fri	Sat
	8-Sep	9-Sep	10-Sep	11-Sep	12-Sep
employee 1	Trg	Trg	Trg	AR
employee 2				DP	Trg
employee 3
employee 4	Trg	Trg	Trg	AR
employee 5
employee 6
employee 7				DP	Trg
employee 8	Trg	Trg	Trg	AR
employee 9
employee 10				DP
employee 11				AR
employee 12
employee 13				AR
employee 14

<colgroup><col><col span="5"></colgroup><tbody>
</tbody>

Appreciate all help

cheers
Mark

 

[MarkRandall]

Just a little more....I read you comments in green but not sure how to apply it to a range of cells to be specific, I need the macro to work from cells F4 through FB371.

Does this help?

cheers

 

[Trebor76]

So what is the pattern i.e. the first column with the 'AR' or 'AD' flag is F were columns C to E and G to I will be filled with 'Trg', then...

 

[MarkRandall]

thats right,

The AR and DP align with dates but these are all over the place because of staggered rosters. That is why I think the macro will work otherwise I will need to do it manually.

cheers

 

[Trebor76]

Try this while on the Sheet in question:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngLastCol As Long
    Dim rngMyCell As Range
    Dim lngMyOffset As Long
    
    On Error Resume Next 'Account for there being no data on the tab
        lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lngLastCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    On Error GoTo 0
    
    If lngLastRow + lngLastCol = 0 Then
        MsgBox "There is no data on the current tab to work with!!", vbExclamation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    For Each rngMyCell In Range(Cells(4, 2), Cells(lngLastRow, lngLastCol))
        Select Case StrConv(rngMyCell, vbUpperCase)
            Case Is = "AR"
                For lngMyOffset = -3 To -1
                    rngMyCell.Offset(0, lngMyOffset).Value = "Trg"
                Next lngMyOffset
            Case Is = "DP"
                For lngMyOffset = 1 To 3
                    rngMyCell.Offset(0, lngMyOffset).Value = "Trg"
                Next lngMyOffset
        End Select
    Next rngMyCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is now complete."

End Sub

Regards,

Robert

 

[MarkRandall]

Hi Robert,

Thanks...just tried it and I get the following error

run time error 1004 application define or object defined error

when i click debug it highlights this line of code

rngMyCell.Offset(0, lngMyOffset).Value = "Trg"

any thoughts?

cheers

 

[Trebor76]

At a guess I'd say the first 'AR' the code has found is either in column A, B or C so when it's trying to return 'Trg' it can't because three columns to the left of column A, B or C is effectively off the sheet.

See how this goes:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngLastCol As Long
    Dim rngMyCell As Range
    Dim lngMyOffset As Long
    
    On Error Resume Next 'Account for there being no data on the tab
        lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lngLastCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    On Error GoTo 0
    
    If lngLastRow + lngLastCol = 0 Then
        MsgBox "There is no data on the current tab to work with!!", vbExclamation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    For Each rngMyCell In Range(Cells(4, 2), Cells(lngLastRow, lngLastCol))
        Select Case StrConv(rngMyCell, vbUpperCase)
            Case Is = "AR"
                On Error Resume Next
                    For lngMyOffset = -3 To -1
                        rngMyCell.Offset(0, lngMyOffset).Value = "Trg"
                    Next lngMyOffset
                On Error GoTo 0
            Case Is = "DP"
                On Error Resume Next
                    For lngMyOffset = 1 To 3
                        rngMyCell.Offset(0, lngMyOffset).Value = "Trg"
                    Next lngMyOffset
                On Error GoTo 0
        End Select
    Next rngMyCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is now complete."

End Sub

Robert

 

[MarkRandall]

That's it Robert

Your a champ...thanks a lot for the help

cheers
Mark

 

[Trebor76]

Thanks for letting us know and you're welcome