Results 1 to 2 of 2
  1. #1
    New Lounger
    Join Date
    Mar 2015
    Thanked 0 Times in 0 Posts

    Question Change input value based on certain criteria

    I am trying to get my input value to change based on count
    I have a sheet which i am using for attendance I have a macro running which takes phone number and date as values and marks Present for the day. i have columns E:AI as days 1-31 and a "P" is entered to mark as Present for the day. There is a another Column "AN" which hold a number e.g. 12. which is the number of times the user can be present.
    Question: how would i count the number of P in the cells from E:AI and mark the Last turn as "E"
    eg: if the Column "AN" has value 12 in it the 12th Turn is automatically entered as E . even if a P is Put in there,

    Any Help will be appreciated


    Sub Find_mobilenumber()
    Dim FindString As String
    Dim FindString1 As String
    Dim PhoneRng As Range
    Dim Rng As Range
    FindString = InputBox("Enter Your Mobile Number")
    FindString1 = InputBox("Enter todays Date - e.g 21  for 21/03/2015")
    If Trim(FindString) <> "" Then
        If Trim(FindString1) <> "" Then
            With Sheets("Sheet1").Range("D:D") 'searches for phone no in column D
                    Set PhoneRng = .Find(What:=FindString, _
                                  After:=.Cells(.Cells.Count), _
                                  LookIn:=xlValues, _
                                  LookAt:=xlWhole, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
            End With
            With Sheets("Sheet1").Range("7:7") 'searches all of column 7
                Set Rng = .Find(What:=FindString1, _
                              After:=.Cells(.Cells.Count), _
                              LookIn:=xlValues, _
                              LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlNext, _
            End With
            On Error GoTo ErrorHandler
                Intersect(Rng.EntireColumn, PhoneRng.EntireRow).Value = "P"
                MsgBox (" Checked In")
    End If
        End If
    Exit Sub
    MsgBox ("Not Registered")
    End Sub
    Attached Images Attached Images

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Manning, South Carolina
    Thanked 1,605 Times in 1,449 Posts

    Welcome to the Lounge as a new poster!

    This code placed in the Worksheet Module will do the trick.
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
       Dim isect As Range
       Dim iPresents As Integer
       Set isect = Application.Intersect(Range("E8:AI10"), Target)
       If isect Is Nothing Then
         '***Prevent following code from refiring Change Event ***
         Application.EnableEvents = False
    '***** Your code here   *****
          iPresents = WorksheetFunction.CountA(Range(Cells(Target.Row, "E").Address & ": " & Target.Address))
          If iPresents = Cells(Target.Row, "AN") Then Target.Value = "E"
    '***** End of your code *****
         Application.EnableEvents = True '*** Reset Events ***
       End If
    End Sub
    Please note that the code between the comments assumes that the P's are entered in order and no other values are entered! If this is not true the code needs to be more complicated such as using a loop to count only the P's.

    Note: You'll need to change the Row in the Intersect command to match the last row of your data. Better yet name the range where your data is and use the range name in the code.

    BTW: It makes things easier for those trying to help you if you actually upload a sample file, instead of just a picture, with sample data.

    Test File: Shahab.xlsm

    May the Forces of good computing be with you!


    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts