Have a cell count

A

Ahhhh

New Member
Joined
May 31, 2015
Messages
29
Hi all,
Alright, so I know this will take VBA.
I would like for cell A1 to add 1 (to count) the number of times a word (yes) appears in cell a2.
Example: cell A1 = 0, A2 = yes then A1 = 1, A2 = no then A1 = 1, A2 = yes then A1 =2
Any help would be appreciated
Ahhhhh, this is driving me crazy
 
Sort by date Sort by votes
MARK858 said:
First of all the bits in the code that were in capitals needed to remain in capitals and so your code with your actual ranges needed to be

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$29" Then
If UCase(Target.Value) = UCase("YES") Then Range("A28").Value = Range("A28").Value + 1
End If

End Sub

Then it would have worked if you were manually changing A29 but you are not!, you are trying to get a macro to run at the change of the formula result.

I'm afraid that won't trigger a macro, instead try making the change in red to your main code instead.

Code: 
Private Sub CommandButton1_Click()
    Dim T, E, M As Double, S As Double

    T = Timer
    Do
        E = CDbl(Time) * 24 * 60 * 60 - T
        M = AllowedTime - 1 - Int(E / 60)
        S = 59 - Round((E / 60 - Int(E / 60)) * 60, 0)

        With tBx1
            .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
        End With
        DoEvents
        [COLOR=#FF0000]If (Timer - T) / 60 = AllowedTime Then Range("A28").Value = Range("A28").Value + 1[/COLOR]
    Loop Until (Timer - T) / 60 >= AllowedTime
End Sub

By the way just to let you know that the way you have dimmed your variables T and E are variants not doubles.
Click to expand...

That works perfect, thank you so much. You're great.
Curious thing happens now, I have some VLOOKUPs on the page as well, looking at a28, they loose code when the above code executes.
Sorry do you have any ideas on this.
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Thanks for the feedback and welcome to the board :)
 
Upvote 0
MARK858 said:
Thanks for the feedback and welcome to the board :)
Click to expand...
Hello Again
I figured that I would ask you, prior to posting, since you have seen the code already.
I was trying to make the Timer work with a variable not a constant.
Wondering if you have any ideas
Code: 
Public Const AllowedTime As Double = 1[CODE]
Private Sub CommandButton1_Click()Dim T, E, M As Double, S As Double


T = Timer
Do
E = CDbl(Time) * 24 * 60 * 60 - T
M = AllowedTime - 1 - Int(E / 60)
S = 59 - Round((E / 60 - Int(E / 60)) * 60, 0)

With tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With
DoEvents
If (Timer - T) / 60 = AllowedTime Then
Range("A28").Value = Range("A28").Value + 1

Range("B1").Value = "=VLOOKUP(A28,A2:E26,2,0)"
Range("B1") = Range("B1")


Range("C1").Value = "=VLOOKUP(A28,A2:E26,3,0)"
Range("C1") = Range("C1")


Range("D1").Value = "=VLOOKUP(A28,A2:E26,4,0)"
Range("D1") = Range("D1")


Range("E1").Value = "=VLOOKUP(A28,A2:E26,5,0)"
Range("E1") = Range("E1")

Range("B27").Value = "=VLOOKUP(A28+1,A2:E26,2,0)"
Range("B27") = Range("B27")


Range("C27").Value = "=VLOOKUP(A28+1,A2:E26,3,0)"
Range("C27") = Range("C27")


Range("D27").Value = "=VLOOKUP(A28+1,A2:E26,4,0)"
Range("D27") = Range("D27")


Range("E27").Value = "=VLOOKUP(A28+1,A2:E26,5,0)"
Range("E27") = Range("E27")

Range("G27").Value = "=(f27) & (G22*J22+G24*J24+G25*J25)"
Range("G28") = Range("G27")

Range("G26").Value = "=+G22*(K22+G24*K24+G25*K25)/G23"
Range("G26") = Range("G26")




End If
Loop Until (Timer - T) / 60 >= AllowedTime


Call CommandButton1_Click


End Sub[/CODE]
Thanks for any help
 
Upvote 0
Can't post any code until I am home this evening but is this not the same question you have addressed to JoeMo in your other thread?
 
Last edited:
Upvote 0
MARK858 said:
Can't post any code until I am home this evening but is this not the same question you have addressed to JoeMo in your other thread?
Click to expand...

Hello,
Yes I got a reply from JoeMo and was thankful for it. I just have not gotten it to work and in his reply it felt he did not have time at the moment to help me with figuring it out.
 
Upvote 0
Try the code below posted by LJMetzer.
I have attached a link to a workbook so you can see how it is used.

You will need to adapt it if you want the counter in a cell as I also don't have much time at the moment.

ThisWorkbook module:


Code: 
Private Sub Workbook_Open()

  Call Reset1MinuteCountDownTimer

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

  'Shut down the 'Timer' to make sure it isn't accidentally scheduled
  'when the workbook is closed
  Call Timer0Stop
  
End Sub


Regular module

Code: 
''''''''''''''''''''''''''''''''''''''''''''''''
'Timer specific variables
''''''''''''''''''''''''''''''''''''''''''''''''
Public bTimer0Active As Boolean
Public yTimer0ExpirationDateAndTime As Double

''''''''''''''''''''''''''''''''''''''''''''''''
'Application specific constants
''''''''''''''''''''''''''''''''''''''''''''''''
Const sTimeDisplaySheetNAME = "Sheet1"
Const sTimeDisplayCELL = "F4"

Const nStartTimeValueinMINUTES = 1
Const nSecondsBetweenDisplayUPDATES = 1
Const MINUTES_PER_DAY = 24 * 60

Public myTargetFinishDateAndTime As Double


''''''''''''''''''''''''''''''''''''''''''''''''
'Timer specific code
''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Timer0Start(iSeconds As Long)
  'This starts 'Timer 0' for the number of seconds in the input parameter
  '
  'It is assumed that 'Timer 0' in not running when this is called

  bTimer0Active = True
  
  'Get the date and time for the next timer event
  yTimer0ExpirationDateAndTime = Now() + TimeSerial(0, 0, iSeconds)
  
  'Arm the timer
  Application.OnTime yTimer0ExpirationDateAndTime, "Timer0ExpirationHandler", , True
  
End Sub

Public Sub Timer0Stop()
  'This stops 'Timer 0'
  
  bTimer0Active = False
  
  On Error Resume Next
  Application.OnTime yTimer0ExpirationDateAndTime, "Timer0ExpirationHandler", , False
  On Error GoTo 0
  
End Sub


Public Sub Timer0ExpirationHandler()
  'This is the generic 'Timer 0' Expiration Event Handler
  'The application must have a project 'Timer 0' Event Handler
  
  'Call the project specific Timer Event Handler
  Call ProjectSpecificEventHandler

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''
'Application specific code
''''''''''''''''''''''''''''''''''''''''''''''''
Sub Start1MinuteCountDownTimer()

  Dim myTime As Date

  'Stop the Timer if it is already running
  Call Timer0Stop
  
  'Set the time to 20 minutes
  Call Reset1MinuteCountDownTimer
  
  'Get the time value from the count down timer cell
  myTime = ThisWorkbook.Sheets(sTimeDisplaySheetNAME).Range(sTimeDisplayCELL)
  
  'Set the expiration date and time
  myTargetFinishDateAndTime = Now() + myTime
  
  'Start the timer
  Call Timer0Start(nSecondsBetweenDisplayUPDATES)


End Sub

Sub PauseRestart1MinuteCountDownTimer()
  'This restarts the timer if it is stopped
  'This stops the timer if it is running
  
  Dim myTime As Date

  If bTimer0Active = True Then
    Call Timer0Stop
  Else
    'Get the time value from the count down timer cell
    myTime = ThisWorkbook.Sheets(sTimeDisplaySheetNAME).Range(sTimeDisplayCELL)
    
    'Set the expiration date and time
    myTargetFinishDateAndTime = Now() + myTime
    
    'Start the timer
    Call Timer0Start(nSecondsBetweenDisplayUPDATES)
  End If

End Sub

Sub Reset1MinuteCountDownTimer()

  Dim myTime As Date
  
  myTime = nStartTimeValueinMINUTES / MINUTES_PER_DAY

  Call Timer0Stop
  ThisWorkbook.Sheets(sTimeDisplaySheetNAME).Range(sTimeDisplayCELL) = myTime

End Sub

Sub ProjectSpecificEventHandler()
  'This is activated when the scheduled Timer0 comes to life
    
   Dim myTimeRemaining As Double
   Dim myDateAndTime As Double
   
   'Get the current date and time
   myDateAndTime = Now()
   
   'Display the time remaining in the Timer display
   myTimeRemaining = myTargetFinishDateAndTime - Now()
   
   'Do not allow a negative time to be displayed
   If myTimeRemaining < 0 Then
     myTimeRemaining = 0
   End If
   
   'Display the time remaining
   ThisWorkbook.Sheets(sTimeDisplaySheetNAME).Range(sTimeDisplayCELL) = myTimeRemaining
   
  'Start the elapsed time timer again if there is time remaining
  If myTimeRemaining > 0 Then
    Call Timer0Start(nSecondsBetweenDisplayUPDATES)
  End If
  
End Sub


http://app.box.com/s/x87e0wax0qajj8soj7ufwqbrlmbnaby7
 
Upvote 0
MARK858 said:
Try the code below posted by LJMetzer.
I have attached a link to a workbook so you can see how it is used.

You will need to adapt it if you want the counter in a cell as I also don't have much time at the moment.

ThisWorkbook module:


Code: 
Private Sub Workbook_Open()

  Call Reset1MinuteCountDownTimer

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

  'Shut down the 'Timer' to make sure it isn't accidentally scheduled
  'when the workbook is closed
  Call Timer0Stop
  
End Sub


Regular module

Code: 
''''''''''''''''''''''''''''''''''''''''''''''''
'Timer specific variables
''''''''''''''''''''''''''''''''''''''''''''''''
Public bTimer0Active As Boolean
Public yTimer0ExpirationDateAndTime As Double

''''''''''''''''''''''''''''''''''''''''''''''''
'Application specific constants
''''''''''''''''''''''''''''''''''''''''''''''''
Const sTimeDisplaySheetNAME = "Sheet1"
Const sTimeDisplayCELL = "F4"

Const nStartTimeValueinMINUTES = 1
Const nSecondsBetweenDisplayUPDATES = 1
Const MINUTES_PER_DAY = 24 * 60

Public myTargetFinishDateAndTime As Double


''''''''''''''''''''''''''''''''''''''''''''''''
'Timer specific code
''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Timer0Start(iSeconds As Long)
  'This starts 'Timer 0' for the number of seconds in the input parameter
  '
  'It is assumed that 'Timer 0' in not running when this is called

  bTimer0Active = True
  
  'Get the date and time for the next timer event
  yTimer0ExpirationDateAndTime = Now() + TimeSerial(0, 0, iSeconds)
  
  'Arm the timer
  Application.OnTime yTimer0ExpirationDateAndTime, "Timer0ExpirationHandler", , True
  
End Sub

Public Sub Timer0Stop()
  'This stops 'Timer 0'
  
  bTimer0Active = False
  
  On Error Resume Next
  Application.OnTime yTimer0ExpirationDateAndTime, "Timer0ExpirationHandler", , False
  On Error GoTo 0
  
End Sub


Public Sub Timer0ExpirationHandler()
  'This is the generic 'Timer 0' Expiration Event Handler
  'The application must have a project 'Timer 0' Event Handler
  
  'Call the project specific Timer Event Handler
  Call ProjectSpecificEventHandler

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''
'Application specific code
''''''''''''''''''''''''''''''''''''''''''''''''
Sub Start1MinuteCountDownTimer()

  Dim myTime As Date

  'Stop the Timer if it is already running
  Call Timer0Stop
  
  'Set the time to 20 minutes
  Call Reset1MinuteCountDownTimer
  
  'Get the time value from the count down timer cell
  myTime = ThisWorkbook.Sheets(sTimeDisplaySheetNAME).Range(sTimeDisplayCELL)
  
  'Set the expiration date and time
  myTargetFinishDateAndTime = Now() + myTime
  
  'Start the timer
  Call Timer0Start(nSecondsBetweenDisplayUPDATES)


End Sub

Sub PauseRestart1MinuteCountDownTimer()
  'This restarts the timer if it is stopped
  'This stops the timer if it is running
  
  Dim myTime As Date

  If bTimer0Active = True Then
    Call Timer0Stop
  Else
    'Get the time value from the count down timer cell
    myTime = ThisWorkbook.Sheets(sTimeDisplaySheetNAME).Range(sTimeDisplayCELL)
    
    'Set the expiration date and time
    myTargetFinishDateAndTime = Now() + myTime
    
    'Start the timer
    Call Timer0Start(nSecondsBetweenDisplayUPDATES)
  End If

End Sub

Sub Reset1MinuteCountDownTimer()

  Dim myTime As Date
  
  myTime = nStartTimeValueinMINUTES / MINUTES_PER_DAY

  Call Timer0Stop
  ThisWorkbook.Sheets(sTimeDisplaySheetNAME).Range(sTimeDisplayCELL) = myTime

End Sub

Sub ProjectSpecificEventHandler()
  'This is activated when the scheduled Timer0 comes to life
    
   Dim myTimeRemaining As Double
   Dim myDateAndTime As Double
   
   'Get the current date and time
   myDateAndTime = Now()
   
   'Display the time remaining in the Timer display
   myTimeRemaining = myTargetFinishDateAndTime - Now()
   
   'Do not allow a negative time to be displayed
   If myTimeRemaining < 0 Then
     myTimeRemaining = 0
   End If
   
   'Display the time remaining
   ThisWorkbook.Sheets(sTimeDisplaySheetNAME).Range(sTimeDisplayCELL) = myTimeRemaining
   
  'Start the elapsed time timer again if there is time remaining
  If myTimeRemaining > 0 Then
    Call Timer0Start(nSecondsBetweenDisplayUPDATES)
  End If
  
End Sub


http://app.box.com/s/x87e0wax0qajj8soj7ufwqbrlmbnaby7
Click to expand...

Thanks again for the help, I will see what I can do.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Making workbook lighter / optimizing
Replies
2
Views
158
Beneindias
B
J
  • Solved
Matching a character
Replies
2
Views
243
jollyn
J
D
  • Question
How do you calculate the number of first days of the month have passed between a set date and today
Replies
4
Views
164
damian_r_Home
D
willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
143
willow1985
willow1985
C
  • Question
VBA copy paste cells one by one
Replies
1
Views
70
Joe4
Joe4

Forum statistics

Threads
1,215,811
Messages
6,127,020
Members
449,351
Latest member
Sylvine

Share this page

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