Validation input text Col C conditional on text in Col B

[Ironman]

Hi

I have the following code that I want to run once in Col C of sheets 'Training Log' and 'Training 1981-1997', which creates a validation input msg ""Double click for lifetime mileage total up to this date" in the rows where Col 9 starts with the text string "Day"

Sub InsertValidationInput
If ActiveSheet.Name = "Training Log" and "Training 1981-1997" and If target.Column = C And Left(target.Value, 3) = "Day" Then
Application.EnableEvents = False
With Selection.Validation
          .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
          :=xlBetween
          .IgnoreBlank = True
          .InCellDropdown = False
          .InputTitle = ""
          .ErrorTitle = ""
          .InputMessage = "Double click for lifetime mileage total up to this date"
          .ErrorMessage = ""
          .ShowInput = True
          .ShowError = True
         Application.EnableEvents = True
        End With
End Sub

Can you please tell me if there are any obvious errors in this code?

Many thanks!

 

[NoSparks]

Good morning

After re-reading and looking at the Exercise Log.xlsm linked to in a previous question,
I believe this is what you require.

Sub InsertValidationInput()

    Dim i As Long, LastRow As Long, col As Long

If ActiveSheet.Name <> "Training 1981-1997" And ActiveSheet.Name <> "Training Log" Then
    MsgBox "This function will only run in Training Log sheets", vbInformation, "Function Invalid in This Sheet"
    Exit Sub
End If

If ActiveSheet.Name = "Training Log" Then col = 9           'column I for "Day"
If ActiveSheet.Name = "Training 1981-1997" Then col = 7     'column G for "Day"

LastRow = Range("C" & Rows.Count).End(xlUp).Row

For i = 12 To LastRow
    If Cells(i, 3).Value <> "" And Left(Cells(i, col).Value, 3) = "Day" Then
        With Cells(i, 2).Validation
             .Delete
             .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
             .IgnoreBlank = True
             .InCellDropdown = False
             .InputTitle = ""
             .ErrorTitle = ""
             .InputMessage = "Double click for lifetime mileage total up to this date"
             .ErrorMessage = ""
             .ShowInput = True
             .ShowError = True
        End With
    End If
Next i
End Sub

I suspect you'll want to alter the message to indicate the double click should be on the date in column A.

Hope that works the way you're wanting.
NoSparks

 

[Ironman]

OK I've now substituted data for the ???, I've run the below and it returned For without Next. I entered Next as below and it didn't run.

Sub InsertValidationInput()

Dim i As Long, LastRow As Long

If ActiveSheet.Name <> "Training 1981-1997" And ActiveSheet.Name <> "Training Log" Then
MsgBox "This function will only run in Training Log sheets", vbInformation, "Function Invalid in This Sheet"
Exit Sub
End If

LastRow = Range("C" & Rows.Count).End(xlUp).Row
For i = 12 To LastRow
If Left(Cells(i, 3).Value, 3) = "Day" Then
With Cells(i, 3).Validation
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = False
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = "Double click for lifetime mileage total up to this date"
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
Application.EnableEvents = True
End With
End If
Next
End Sub

Can somebody please tell me what I'm missing?

Many thanks!

Good morning

After re-reading and looking at the Exercise Log.xlsm linked to in a previous question,
I believe this is what you require.

Sub InsertValidationInput()

    Dim i As Long, LastRow As Long, col As Long

If ActiveSheet.Name <> "Training 1981-1997" And ActiveSheet.Name <> "Training Log" Then
    MsgBox "This function will only run in Training Log sheets", vbInformation, "Function Invalid in This Sheet"
    Exit Sub
End If

If ActiveSheet.Name = "Training Log" Then col = 9           'column I for "Day"
If ActiveSheet.Name = "Training 1981-1997" Then col = 7     'column G for "Day"

LastRow = Range("C" & Rows.Count).End(xlUp).Row

For i = 12 To LastRow
    If Cells(i, 3).Value <> "" And Left(Cells(i, col).Value, 3) = "Day" Then
        With Cells(i, 2).Validation
             .Delete
             .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
             .IgnoreBlank = True
             .InCellDropdown = False
             .InputTitle = ""
             .ErrorTitle = ""
             .InputMessage = "Double click for lifetime mileage total up to this date"
             .ErrorMessage = ""
             .ShowInput = True
             .ShowError = True
        End With
    End If
Next i
End Sub

I suspect you'll want to alter the message to indicate the double click should be on the date in column A.

Hope that works the way you're wanting.
NoSparks

Hi NS, many thanks, no worries re amending message - before I run it, can I just confirm that the code inserts the validation input msgs in Col C in Training Log, only where Col I starts with the word "Day" and in Training 1981-1997 only where Col G starts with with the word "Day"?

My reason for double checking is that you said the message should refer to the double click in Col A whereas it's actually in Col C.

Thanks again!

 

[NoSparks]

        With Cells(i, 2).Validation  '<~~~~~~ the cell to get validation

change the 2 to 3 for column C

My reason for double checking is that you said the message should refer to the double click in Col A whereas it's actually in Col C.

OK, my mistake.

 

[Ironman]

        With Cells(i, 2).Validation  '<~~~~~~ the cell to get validation

change the 2 to 3 for column C


OK, my mistake.

Just going on the indoor bike for an hour, I'll let you know how it runs in a couple of hours

 

[Ironman]

Hi NS, thank you so much, it works beautifully in both sheets and I'm really grateful for the time you've given to me.

Thanks for your patience and for persevering with me!

 

[NoSparks]

You're welcome Paul
I don't think you've marked the right post as the answer (even though I missed the validation cell by a column)
You'll also probably want to add something like this to the current Worksheet_BeforeDoubleClick of the Training Log sheet

    ' Distance run up to Target.row date
    If target.Column = 3 And target.Value <> "" Then
        Cancel = True
        MsgBox "Total miles run to " & Cells(target.Row, 1).Value & " is " & _
                Format(Application.Sum(Range("C12:C" & target.Row)), "#,##0.00")
    End If

No doubt you'll want to 'pretty up' the message box somewhat.

 

[Ironman]

Oops, my mistake Nolan, thanks for pointing that out!

And thanks also for giving thought to the DoubleClick event as well (which MichaelM actually kindly provided last month here)

 

[Ironman]

Hi Nolan

Your code's working exactly as I requested, but I've just noticed it's overwriting any additional text I entered into some of the existing entries e.g.

"Route map measured 19/4/86

Double click for lifetime mileage total up to this date"

Becomes

"Double click for lifetime mileage total up to this date"

Is there any way of adding a line to your solution so that the code will only run when there is no existing validation please?

Many thanks again!

 

[NoSparks]

the last file I downloaded has this in your InsertMlgValidationinput module so try adding this UDF (user defined function) to the module
Note: the function being Private makes it available only to the module it is in.

' from https://newbedev.com/determine-if-cell-contains-data-validation
Private Function HasValidation(cell As Range) As Boolean
    Dim t: t = Null
On Error Resume Next
t = cell.Validation.Type
On Error GoTo 0
HasValidation = Not IsNull(t)
End Function

and adding an additional IF requirement to the InsertValidationInput procedure

   If Cells(i, 3).Value <> "" And Left(Cells(i, col).Value, 3) = "Day" And HasValidation(Cells(i, 3)) = False Then

I haven't actually tested this, hopefully it works

 

[Ironman]

Hi Nolan, thanks for coming back to me, hope all's good with you?

I've just tested your addition and it works perfectly, thanks ever so much!