Message Box showing number of times a certain word followed by a digit occurs first in rows in column

[Ironman]

Hi

Sheet 'Training 1981-1997' Column F2:F6210 contains text, with some rows that start with the word "Day" (without the commas) followed by a space and a number.

I need to cross-check to make sure I haven't skipped or duplicated a number in error. Therefore what I'd be grateful for is some double click event code I can run in any cell in Col G that will return a msgbox that has counted the number of cells in Col F2:F6210 with text beginning with the word "Day" followed by a space and a digit e.g. "Day 123". I've used the 'Find' function to do this so far, but it'll be faster just to double click.

Many thanks!

 

[Ironman]

Doesn't your existing Worksheet_BeforeDoubleClick code exit the sub if the Target.Column is > 1 ?

Haha, hi NS, good to hear from you - you're right, hadn't realised that.

Here's the rest of the event code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Opens find and replace box when double clicking Cell in Column A (double clicking Col A in Training Log and Indoor Bike sheets runs finddate macro (located in Toolbar Macros).
'Because the format of Col A is text, not date, finddate won't find any dates.

    If Target.Column = 1 And Target.Row > 1 Then
If Target.Row = 1 Or Target.Column > 1 Then Exit Sub
    Cancel = True
    MsgBox "Ensure 'Match case' Box Is Checked", vbExclamation, "Find Box"
    Application.Dialogs(xlDialogFormulaFind).Show  '21.11.2021 discovered this on the net.  No idea why I wasn't given this instead of 'replace' below, which I've commented out.
    'Application.Dialogs(xlDialogFormulaReplace).Show
End If

'The following code returns cumulative mileage since 16.04.1981 when any cell in Column C is double clicked

    If Cells(Target.Row, "B").Value = "REST" Or Cells(Target.Row, "B").Value = "" Then Exit Sub
    ' check Target is in column C
    If Target.Column = 3 And Target.Row >= 2 Then ' when any cell in column C row 2 downwards is double-clicked
        Cancel = True
        TopCell = Cells(2, 3).Address 'Row 3, Column 3 i.e. mileage
        BottomCell = Cells(Target.Row, 3).Address

        TotalCalc = Application.WorksheetFunction.Sum(Range(TopCell, BottomCell))

        MsgBox "Total miles run to date: " & _
                     Format((CLng(0 + TotalCalc)), "#,##0") & "   ", vbOKOnly, "Lifetime Mileage"
    
    End If
    
'27.01.2022 When F1 is double clicked, the below code selects the last filled row in Col B courtesy of Peter_SSs https://www.mrexcel.com/board/threads/vba-selection_change-event-go-to-first-empty-cell-in-column.1194094/
   If Selection.Address = "$F$1" Then Range("B" & Rows.Count).End(xlUp).Select

Application.Calculation = xlCalculationAutomatic
End Sub

 

[My Aswer Is This]

So now your saying you have two double click scripts in the same sheet?
Is that correct?

 

[Ironman]

So now your saying you have two double click scripts in the same sheet?
Is that correct?

Yes, there are 2 others with the Exit Sub line in the same sheet. I guess the Exit Sub lines need to be modified but I don't know how.

 

[My Aswer Is This]

Yes, there are 2 others with the Exit Sub line in the same sheet. I guess the Exit Sub lines need to be modified but I don't know how.

Well you never mentioned this before:

We will need to see all the code you have in your sheet;
Post all the code you have no matter if it's double click or sheet change.

 

[mumps]

I tested the code on a dummy file and it worked properly. It will work only when you double click the cell in Col G adjacent to the latest entry in Col F. Did you place the macro in the worksheet code module?

 

[Ironman]

I tested the code on a dummy file and it worked properly. It will work only when you double click the cell in Col G adjacent to the latest entry in Col F. Did you place the macro in the worksheet code module?

Hi Mumps, thanks for the additional info. The reason it's not running is because of 2 other scripts within the Double Click event that include an Exit Sub line (see previous posts) but I don't know how to get around those to make this work.

@My Aswer Is This this is the only other code in the sheet:

Private Sub Worksheet_Change(ByVal Target As Range)

'22.12.2021 Adapted from the above code to clear pace formula in Col E for REST entries
If Target.Column = 2 And Target.Value = "REST" Then
Target.Font.Italic = True
Range("E" & Target.Row).ClearContents
Range("F" & Target.Row).Select 'Jump to Col F for any comments
End If


'16.12.2021 Adapted from 01.10.2021 NoSparks' code to fill current row for non-rest entries
If Target.Column = 2 And Target.Row <= 6210 And Target.Value <> "REST" Then
Range("A" & Target.Row).Resize(, 7).Interior.Color = RGB(251, 243, 181) 'Col A and next 6 columns
End If


'16.01.2022 After entering data in Col F, go to Col B of next row
If Target.Column = 6 Then
Range("B" & ActiveCell.Row).Select
End If
End Sub

 

[mumps]

Try:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Dim lRow As Long, v As Variant, i As Long, x As Long
    lRow = Range("F" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("B:B,G:G,F:F")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case Is = 2
            If Target.Value = "REST" Then
                Target.Font.Italic = True
                Range("E" & Target.Row).ClearContents
                Range("F" & Target.Row).Select
            ElseIf Target.Row <= 6210 And Target.Value <> "REST" Then
                Range("A" & Target.Row).Resize(, 7).Interior.Color = RGB(251, 243, 181)
            End If
        Case Is = 6
            Range("B" & ActiveCell.Row).Select
        Case Is = 7
            v = Range("F2:F" & lRow).Value
            For i = LBound(v) To UBound(v)
                If v(i, 1) Like "Day *" And IsNumeric(Mid(v(i, 1), 5)) Then
                    x = x + 1
                End If
            Next i
            MsgBox x
    End Select
    Application.ScreenUpdating = True
End Sub

 

[Ironman]

Aha, now I'm getting the msgbox, many thanks. However, the value I'm getting is "9" and I don't know what that is, because the result should be 389.

 

[My Aswer Is This]

Aha, now I'm getting the msgbox, many thanks. However, the value I'm getting is "9" and I don't know what that is, because the result should be 389.

So your saying the script should have Day and the rest 389 times in the range you gave us.

 

[Ironman]

So your saying the script should have Day and the rest 389 times in the range you gave us.

The word Day followed by a space and a number occurs 389 times (i.e. Day 1, Day 2, Day 3...Day 389)