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

    Question Change input value based on certain criteria

    Hi,
    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

    Thanks

    Code:
    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, _
                                  MatchCase:=False)
    
    
            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, _
                              MatchCase:=False)
            End With
    
    
    
    
            On Error GoTo ErrorHandler
    
    
                Intersect(Rng.EntireColumn, PhoneRng.EntireRow).Value = "P"
                MsgBox (" Checked In")
    End If
        End If
    
    
    Exit Sub
    
    
    ErrorHandler:
    
    
    MsgBox ("Not Registered")
    
    
    End Sub
    Attached Images Attached Images

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Shahab,

    Welcome to the Lounge as a new poster!

    This code placed in the Worksheet Module will do the trick.
    Code:
    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
       Else
         '***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

    HTH
    May the Forces of good computing be with you!

    RG

    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
  •