Conditional counting formula 2 times or more

[Excelpromax123]

Hello everyone. I need a VBA formula to count numbers that appear 2 or more times and subtract 1 (for example, counting the number 5 out 5 appears 4 times, the result = 3 ). Thank you

Loading Google Sheets

 

[shinigamilight]

Try this

Function NumCount(rng2 As Range)
        Dim rng As Range
        Dim dic As Object
        Set dic = CreateObject("scripting.dictionary")
        
        For Each rng In rng2
            If rng.Value <> "" Then
                If dic.Exists(rng.Value) = False Then
                    dic(rng.Value) = 0
                Else: dic(rng.Value) = dic(rng.Value) + 1
                End If
            End If
        Next rng
        
        NumCount = WorksheetFunction.Sum(dic.Items)
End Function

 

[Fluff]

How about

Sub Excelpromax()
   Dim Dic As Object
   Dim Cl As Range
   Dim i As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("B3", Range("B" & Rows.count).End(xlUp))
      If Cl.Value <> "" Then
         If Dic.Exists(Cl.Value) Then
            i = i + 1
         Else
            Dic.Add Cl.Value, Nothing
         End If
      End If
   Next Cl
   Range("F3").Value = i
End Sub

 

[Kerryx]

Maybe this

Book1
	B	C	D	E	F
3	1				Result
4	2				4
5	3
6	3
7	4
8	5
9	5
10	5
11	5
12	6
Sheet1

Cell Formulas
Range	Formula
F4	F4	=SUM(IF(COUNTIF(B3:B12,UNIQUE(B3:B12,,FALSE))<2,0,COUNTIF(B3:B12,UNIQUE(B3:B12,,FALSE))-1))

 

[Fluff]

The OP's profile clearly shows 2010 & so does not have the Unique function.

 

[Excelpromax123]

How about

Sub Excelpromax()
   Dim Dic As Object
   Dim Cl As Range
   Dim i As Long
  
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("B3", Range("B" & Rows.count).End(xlUp))
      If Cl.Value <> "" Then
         If Dic.Exists(Cl.Value) Then
            i = i + 1
         Else
            Dic.Add Cl.Value, Nothing
         End If
      End If
   Next Cl
   Range("F3").Value = i
End Sub

Thank you

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Kerryx]

The OP's profile clearly shows 2010 & so does not have the Unique function.

my bad