View Full Version : Help with Count if
mcal45usn
11-10-2016, 12:20 PM
Hello,
I was able to get great help with keeping a running tally on individuals who call in each day. I uploaded a copy and someone did a great job( i uploaded it again so you can see, and see what im looking to do). I have a master list of individuals on hte first page. Aside from the different sheets I have keeping track of call ins for each day. i want a tracker next to each name on the master list also. can someone give me some advice? Ive tried using countif but im doing something wrong. Thank you!17557
Paul_Hossler
11-10-2016, 01:31 PM
I just put the current total in col B of the individuals
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rABS As Range
Dim sName As String
Dim dCount As Long, iWS As Long, iToday As Long, iName As Long
Dim ws As Worksheet
If Sh.Name = "Individuals" Then Exit Sub
If Intersect(Target, Sh.Range("A:A")) Is Nothing Then Exit Sub
sName = Target.Cells(1, 1).Value
If Len(sName) = 0 Then ' cleared the name cell
Target.Cells(1, 2).ClearContents
Exit Sub
End If
iToday = InStr(Sh.Name, " ")
iToday = CLng(Right(Sh.Name, Len(Sh.Name) - iToday))
dCount = 1
Application.ScreenUpdating = False
For iWS = 1 To iToday - 1
Set ws = Worksheets("Day " & Format(iWS, "##")) ' Day 5 had extra space
Set rABS = Range(ws.Cells(6, 1), ws.Cells(Sh.Rows.Count, 1).End(xlUp)).Resize(, 2)
dCount = dCount + Application.WorksheetFunction.CountIf(rABS.Columns(1), sName)
Next iWS
Application.EnableEvents = False
Target.Cells(1, 2).Value = dCount
With Worksheets("Individuals")
iName = -1
On Error Resume Next
iName = Application.WorksheetFunction.Match(sName, .Columns(1), 0)
On Error GoTo 0
If iName <> -1 Then
.Cells(iName, 2).Value = dCount
End If
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
mcal45usn
11-11-2016, 04:02 AM
Thank you, This is exactly what I want, but for some reason, only 2 names have number next to it, there should be a few more. Is there something I need to do? Im probably doing something wrong.
Paul_Hossler
11-11-2016, 09:06 AM
The 'Master' only gets updated when the 'Day N' worksheet is changed since it's faster to just do the one day/one name that changed than all days/all names
The new code only had a few names added mid-month for testing
I can change it to always sweep the 1-to-31 sheets, but I think a 'Force Update' manually run macro would be better
Actually, I was thinking that you probably wanted a 'Clear Data' macro, and some formatting and some cell locking to prevent misplaced inputs
Let me know
mcal45usn
11-11-2016, 09:51 AM
Gotchya thank you again for all your help! What would clear data macro do?
Paul_Hossler
11-11-2016, 10:11 AM
What would clear data macro do?
Short answer = Clear the Data on each Day-N sheet in cols ABCEGI
Also protects cells, adds data validation, some formatting
Option Explicit
Sub UnprotectAll()
Dim i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 1 To 31
Worksheets("Day " & i).Unprotect
Next i
End Sub
Sub ForceUpdate()
Dim rAllNames As Range, rNames As Range, rName As Range
Dim ws As Worksheet
Dim i As Long, iName As Long
If MsgBox("Force an Update of Statistics?", vbYesNo + vbQuestion + vbDefaultButton2, "Force Update") = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Set rAllNames = Worksheets("Individuals").Range("A2")
Set rAllNames = Range(rAllNames, rAllNames.End(xlDown))
Set rAllNames = rAllNames.Resize(rAllNames.Rows.Count, 2)
For i = 31 To 1 Step -1
With Worksheets("Day " & i)
If Len(.Range("A6").Value) = 0 Then GoTo NextDay
Set rNames = .Range("A6")
Set rNames = Range(rNames, .Cells(.Rows.Count, 1).End(xlUp))
For Each rName In rNames.Rows
iName = -1
On Error Resume Next
iName = Application.WorksheetFunction.Match(rName.Cells(1, 1).Value, rAllNames.Columns(1), 0)
On Error GoTo 0
If iName <> -1 Then
If Len(rAllNames.Cells(iName, 2).Value) = 0 Then
rAllNames.Cells(iName, 2).Value = rName.Cells(1, 2).Value
End If
End If
Next
End With
NextDay:
Next i
End Sub
Sub ClearAndReset()
Dim rNames As Range
Dim ws As Worksheet
Dim i As Long
If MsgBox("Clear Data and Reset Formats?", vbYesNo + vbQuestion + vbDefaultButton2, "Clear Data") = vbNo Then
Exit Sub
End If
Set rNames = Worksheets("Individuals").Range("A2")
Set rNames = Range(rNames, rNames.End(xlDown))
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 1 To 31
rNames.Offset(, 1).ClearContents
With Worksheets("Day " & i)
.Select
.Unprotect
.Rows("6:6").Select
ActiveWindow.FreezePanes = False
ActiveWindow.FreezePanes = True
Application.CutCopyMode = False
.Cells.Locked = True
.Range("A3").Locked = False
.Range("A6:A44").Locked = False
.Range("C6:C44").Locked = False
.Range("E6:E44").Locked = False
.Range("G6:G44").Locked = False
.Range("I6:I44").Locked = False
.Range("A6:A44").ClearContents
.Range("B6:B44").ClearContents
.Range("C6:C44").ClearContents
.Range("E6:E44").ClearContents
.Range("G6:G44").ClearContents
.Range("I6:I44").ClearContents
.Columns("M:XFD").Hidden = True
With .Range("A6:A44").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
Formula1:="=" & rNames.Parent.Name & "!" & rNames.Address(True, True)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
.EnableSelection = xlUnlockedCells
End With
Next i
Worksheets("Day 1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.