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

MarkRandall

New Member
Joined
Sep 15, 2015
Messages
11
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

TueWedThuFriSat
8-Sep9-Sep10-Sep11-Sep12-Sep
employee 1TrgTrgTrgAR
employee 2 DP Trg
employee 3
employee 4TrgTrgTrgAR
employee 5
employee 6
employee 7 DP Trg
employee 8TrgTrgTrgAR
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
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Macro or formula Mark?

Macro would be easier to write

Sub Test1

s=4 ' Looks like your data starts in row 4 so you may want to change that
Do until Cells(s,1) = vbnullstring
Dim CheckAR as variant
Err.Clear
On error resume next
CheckAR = Application.Worksheetfunction.Match("AR", Rows(s),0)
If Err.Number = 0 then
Cells(s,CheckAR-1) = "TRG"
Cells(s,CheckAR-2) = "TRG"
Cells(s,CheckAR-3) = "TRG"
Else
End if

Dim CheckDR as variant
Err.Clear
On error resume next
CheckDR = Application.Worksheetfunction.Match("DR", Rows(s),0)
If Err.Number = 0 then
Cells(s,CheckDR+1) = "TRG"
Cells(s,CheckDR+2) = "TRG"
Cells(s,CheckDR+3) = "TRG"
Else
End if
s=s+1
Loop
 
Upvote 0
Hi Mark,

Welcome to MrExcel!!

This macro will do the trick:

Code:
Option Explicit
Sub Macro2()

    Const lngStartRow As Long = 4 'Starting (static) row number for the data. Change to suit if necessary.
    
    Dim lngMyRow As Long
    Dim lngLastRow As Long
    
    On Error Resume Next 'Account for there being no data on the tab.
        lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    
    If lngLastRow < lngStartRow Then
        MsgBox "There is no data from the defined start row!!", vbExclamation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    For lngMyRow = lngStartRow To lngLastRow
        Select Case StrConv(Range("E" & lngMyRow), vbUpperCase) 'Assumes the 'AR' and 'AD' flags are in Col. E. Change to suit if necessary.
            Case Is = "AR"
                Range("B" & lngMyRow & ":D" & lngMyRow).Value = "Trg" 'Populates colums B to D with 'Trg' if the text in Col. E is 'AR'. Change to suit if necessary.
            Case Is = "DP"
                Range("F" & lngMyRow & ":H" & lngMyRow).Value = "Trg" 'Populates colums F to H with 'Trg' if the text in Col. E is 'DP'. Change to suit if necessary.
        End Select
    Next lngMyRow
    
    Application.ScreenUpdating = True
    
    MsgBox "Process is now complete.", vbInformation

End Sub

Regards,

Robert
 
Upvote 0
thanks DebugGalpin, I'll give it a try now.

Only slightly familiar with macros and coding. Will let you know how I go.

cheers
 
Upvote 0
No luck

Here is what I did

Saved worksheet as macro enabled
went to DEveloper tab and opened VB
Inserted a new module under sheet 1
pasted code into new window
saved
enabled all macros
run the macro test one and got the following error msg.

Complie error
Expexted end sub
run it again and then I get

Can't execute code in break mode


Have I done something wrong or missed something?

cheers
 
Upvote 0
When a code fails or errors, it stays active until you press the stop button.
Otherwise I'd suggest using Roberts code !
 
Upvote 0
Hi Robert,

Thanks for the help although I am not quite there. Is there a limit on the columns that this macro is applied to.

It works for column E but I need it to work for the entire spreadsheet

What can I change to make it work?

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

cheers
Mark
 
Last edited:
Upvote 0
DebugGalpin's code is missing the text...

End Sub

...as the very last line of code

You can do this via a formula i.e. put this formula into cell B4 and fill down and across as required...

=IF($E4="AR","Trg","")

...and put this formula into cell F4 and fill down and across as required:

=IF($E4="DP","Trg","")

HTH

Robert
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,312
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top