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

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,047
Office Version
  1. 365
Platform
  1. Windows
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!
 
Last edited:

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,209
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Delete all the existing BeforeDoubleClick macros and test this one:
VBA Code:
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("A:C,G:G,F:F")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case Is = 1
            If Target.Row = 1 Then Exit Sub
            If Target.Offset(, 1).Value = "REST" Or Target.Offset(, 1).Value = "" Then Exit Sub
        Case Is = 2
            If Target.Value = "REST" Then
                Target.Font.Italic = True
                Range("E" & Target.Row).ClearContents
                Range("F" & Target.Row).Select
                If Target.Row <= 6210 And Target.Value <> "REST" Then
                    Range("A" & Target.Row).Resize(, 7).Interior.Color = RGB(251, 243, 181)
                End If
            End If
        Case Is = 3
            If Target.Row >= 2 Then
                Cancel = True
                TopCell = Cells(2, 3).Address
                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
            
        Case Is = 6
            If Target.Address = "$F$1" Then Range("B" & Rows.Count).End(xlUp).Select
            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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,047
Office Version
  1. 365
Platform
  1. Windows
Many thanks mumps - still getting 9 as a result though. You'll see from the sheet that there are 389 Day numbers.

(this code should also be adapted in your code for Col A btw):
VBA Code:
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
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
19,141
Office Version
  1. 2013
Platform
  1. Windows
Many thanks mumps - still getting 9 as a result though. You'll see from the sheet that there are 389 Day numbers.

(this code should also be adapted in your code for Col A btw):
VBA Code:
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
When I run the script I get the proper results.
 

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,047
Office Version
  1. 365
Platform
  1. Windows
When I run the script I get the proper results.
Hmm, this is what I see.

1644172068676.png
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,209
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Try:
VBA Code:
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, x As Long
    lRow = Range("F" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("A:C,G:G,F:F")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case Is = 1
            If Target.Row = 1 Then Exit Sub
            If Target.Offset(, 1).Value = "REST" Or Target.Offset(, 1).Value = "" Then Exit Sub
            Cancel = True
            MsgBox "Ensure 'Match case' Box Is Checked", vbExclamation, "Find Box"
            Application.Dialogs(xlDialogFormulaFind).Show
        Case Is = 2
            If Target.Value = "REST" Then
                Target.Font.Italic = True
                Range("E" & Target.Row).ClearContents
                Range("F" & Target.Row).Select
                If Target.Row <= 6210 And Target.Value <> "REST" Then
                    Range("A" & Target.Row).Resize(, 7).Interior.Color = RGB(251, 243, 181)
                End If
            End If
        Case Is = 3
            If Target.Row >= 2 Then
                Cancel = True
                TopCell = Cells(2, 3).Address
                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
            
        Case Is = 6
            If Target.Address = "$F$1" Then Range("B" & Rows.Count).End(xlUp).Select
            Range("B" & ActiveCell.Row).Select
        Case Is = 7
        Range("A1").CurrentRegion.AutoFilter 6, "Day*"
        x = [subtotal(103,A:A)] - 1
        MsgBox x
    End Select
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,209
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Try the macro in Post #45.
 

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,047
Office Version
  1. 365
Platform
  1. Windows
Try:
VBA Code:
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, x As Long
    lRow = Range("F" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("A:C,G:G,F:F")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case Is = 1
            If Target.Row = 1 Then Exit Sub
            If Target.Offset(, 1).Value = "REST" Or Target.Offset(, 1).Value = "" Then Exit Sub
            Cancel = True
            MsgBox "Ensure 'Match case' Box Is Checked", vbExclamation, "Find Box"
            Application.Dialogs(xlDialogFormulaFind).Show
        Case Is = 2
            If Target.Value = "REST" Then
                Target.Font.Italic = True
                Range("E" & Target.Row).ClearContents
                Range("F" & Target.Row).Select
                If Target.Row <= 6210 And Target.Value <> "REST" Then
                    Range("A" & Target.Row).Resize(, 7).Interior.Color = RGB(251, 243, 181)
                End If
            End If
        Case Is = 3
            If Target.Row >= 2 Then
                Cancel = True
                TopCell = Cells(2, 3).Address
                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
        
        Case Is = 6
            If Target.Address = "$F$1" Then Range("B" & Rows.Count).End(xlUp).Select
            Range("B" & ActiveCell.Row).Select
        Case Is = 7
        Range("A1").CurrentRegion.AutoFilter 6, "Day*"
        x = [subtotal(103,A:A)] - 1
        MsgBox x
    End Select
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub
That works! Thanks ever so much mumps. Can I please just ask you to modify your code slightly for Col F because I'm unable to double click anything in that column without Col B becoming the active column?

Edit: Also, the last line
VBA Code:
If Selection.Address = "$F$1" Then Range("B" & Rows.Count).End(xlUp).Select/CODE] needs to be included

Thanks again!
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,209
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Delete this line of code:
VBA Code:
Range("B" & ActiveCell.Row).Select
 

Forum statistics

Threads
1,176,668
Messages
5,904,366
Members
435,087
Latest member
maiarib

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
Top