Auto filling a cell in a table which has a list using data validation

[rjn008]

Good Afternoon,

Is it possible to auto populate a cell in a table where by the cell adjacent left has a format on it. The only issue I think I have is I use a list on the cell under data validation, but the list does contain the value I wish to have auto populated?

This is the mini sheet code and image of the style of sheet I am using;

The New LMS ^N4.xlsm
	I	J	K	L	M	N	O
5	Week 1	Week 2	Week 3	Week 4	Week 5	Week 6	Week 7
6	Arsenal	Man City	Chelsea	x	x	x	x
7	Man Utd	Newcastle Utd	x	x	x	x	x
8	Liverpool	Fulham	Arsenal	x	x	x	x
9	Arsenal	Man City	Chelsea	x	x	x	x
10	Arsenal	Man City	Chelsea	x	x	x	x
11	Arsenal	Man City	Brentford	Aston Villa	Liverpool	AFC Bournemouth	West Ham Utd
12	Arsenal	Man City	Chelsea	x	x	x	x
13	Newcastle Utd	Liverpool	Chelsea	x	x	x	x
14	Man Utd	Man City	Brentford	Brighton & HA	x	x	x
15	Newcastle Utd	Tottenham	Chelsea	x	x	x	x
16	Arsenal	Chelsea	Fulham	x	x	x	x
17	Arsenal	Man City	Chelsea	x	x	x	x
18	Newcastle Utd	Tottenham	Brentford	Brighton & HA	x	x	x
19	Newcastle Utd	Liverpool	Arsenal	x	x	x	x
20	Arsenal	Tottenham	Brentford	AFC Bournemouth	x	x	x
21	Liverpool	Man City	Arsenal	x	x	x	x
22	Arsenal	Man City	Chelsea	x	x	x	x
23	Liverpool	Tottenham	Chelsea	x	x	x	x
24	Liverpool	Man City	Chelsea	x	x	x	x
25	Liverpool	Man City	Arsenal	x	x	x	x
26	Newcastle Utd	Liverpool	Aston Villa	Brighton & HA	x	x	x
27	Arsenal	Tottenham	Chelsea	x	x	x	x
28	Man Utd	Liverpool	Chelsea	x	x	x	x
29	Arsenal	Tottenham	Brentford	Brighton & HA	x	x	x
30	Newcastle Utd	Tottenham	Aston Villa	Man Utd	Liverpool	Arsenal	West Ham Utd
31	Man Utd	Fulham	Notts Forest	x	x	x	x
32	Newcastle Utd	Tottenham	Man City	Aston Villa	Man Utd	x	x
33	Liverpool	Man City	Aston Villa	Brighton & HA	x	x	x
34	Arsenal	Tottenham	Aston Villa	Man City	Newcastle Utd	x	x
35	Newcastle Utd	Liverpool	Arsenal	x	x	x	x
36	Newcastle Utd	Man City	Chelsea	x	x	x	x
37	Arsenal	Man City	Brentford	Brighton & HA	x	x	x
38	Newcastle Utd	Man City	Aston Villa	Man Utd	Tottenham	Arsenal	Chelsea
39	Newcastle Utd	Liverpool	Aston Villa	Man City	Tottenham	Chelsea	Arsenal
40	Liverpool	Man City	Fulham	x	x	x	x
41	Man Utd	Fulham	Chelsea	x	x	x	x
42	Liverpool	Tottenham	Brentford	Brighton & HA	x	x	x
43	Arsenal	Chelsea	Aston Villa	Man Utd	Liverpool	Man City	x
44	Arsenal	Man City	Chelsea	x	x	x	x
45	Newcastle Utd	Tottenham	Chelsea	x	x	x	x
46	Newcastle Utd	Liverpool	Chelsea	x	x	x	x
47	Newcastle Utd	Tottenham	Brentford	Aston Villa	Liverpool	Arsenal	AFC Bournemouth
48	Arsenal	Newcastle Utd	x	x	x	x	x
49	Newcastle Utd	Man City	Brentford	Crystal Palace	x	x	x
50	Arsenal	Tottenham	Chelsea	x	x	x	x
51	Newcastle Utd	Tottenham	Brentford	Brighton & HA	x	x	x
52	Tottenham	x	x	x	x	x	x
53	Arsenal	Man City	Aston Villa	Brighton & HA	x	x	x
54	Newcastle Utd	Fulham	Chelsea	x	x	x	x
55	Newcastle Utd	Fulham	Brentford	Brighton & HA	x	x	x
56	Newcastle Utd	Tottenham	Aston Villa	Man City	Liverpool	AFC Bournemouth	Chelsea
LMS #4

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
H3:XFD3,1:2,A3:E3,4:1048576	Expression	=ROW(A1)=CurrentRow	text	NO

Cells with Data Validation
Cell	Allow	Criteria
I6:O56	List	=$H$139:$H$159

I am looking to auto populate the 'x' in any cell that has a strikethrough on the adjacent left cell? Obviously as the weeks move on I would need this to happen in any cell adjacent to a strikethrough no matter what column it was in?

 

[rjn008]

Morning @Micron The button works now thank you. One thing though the 'X' go beyond my table, can this be limited to cells, is there a way of how far to tell this to go?

I am guessing it is going to Column Z as I have the small data table at the side of the main table?

 

[Micron]

Well, asked but not answered as far as I can see:

- where the right most column would be for inserting X (or will it be dynamic?)
- where the left most column is - can't tell if Week1 is col A or something else

Will await your clarification.

 

[rjn008]

Well, asked but not answered as far as I can see:

Will await your clarification.

Hi, apologies, the table range is from column I to column V. The rows start at 6 but will vary in length dependant on number of people

 

[Micron]

Try this version. I left modified parts in but double rem'd them out (2 apostrophes). You can remove these lines if you want.
Replace what you have between your Sub... End Sub lines with this:

Dim Lrow As Long, Lcol As Long
Dim rng As Range, rng2 As Range, cel As Range
Dim row
'cols I to V, row start=6
On Error GoTo errHandler
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

With ActiveSheet
'find last row with data 'removed search for right-most column, assigned 22 (col V )
    ''Lrow = .Cells.Find(what:="*", After:=Range("I5"), LookAt:=xlPart, LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).row
    ''Lcol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Lrow = .Cells.Find(what:="*", After:=Range("I5"), LookAt:=xlPart, LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).row
    Lcol = 22
End With
'create range to loop over based on last row & column with data
''Set rng = Range(Cells(2, 1), Cells(Lrow, Lcol))
Set rng = Range(Cells(6, 9), Cells(Lrow, Lcol)) 'from (row 6, col I) to (last row, col V)
'loop over rows
For Each row In rng.rows
    'loop over cells in the current row
    For Each cel In row.Cells
        'if cel characters font setting is strikethrough:
        If Not cel Is Nothing And cel.Characters.Font.Strikethrough And cel <> "" Then
            'create range from next column to right to last column (based on what Lcol is)
            Set rng2 = Range(Cells(cel.row, cel.Column + 1), Cells(cel.row, Lcol))
            'remove potential strikethrough setting from rng2 lest a cell have previously been strikethrough
            rng2.Characters.Font.Strikethrough = False
            'set rng2 cells to equal X
            rng2 = "X"
        End If
    Next
Next

exitHere:
'clean up
Set rng = Nothing
Set rng2 = Nothing
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
Exit Sub 'exit if no error

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

I hope you are trying this on a copy of your wb. If it still isn't right then you may have to follow up on uploading a copy to a file share. Google sheets are of no use for vba code.

 

[rjn008]

Yes I am trying this on a copy.

I actually uploaded my excel workbook to google drive so unsure how it has come to you...

I will reply again once I have updated the code