Countif function in VBA with an condition

[Alpana]

Hi,


Was tring to work with countif fundtion in VBA for one of my project


In general , my values in the table would be shown as below:


4 columns A, B , C , D as Value , No, Product, Countif.


I need to write a code to count the value column and give the desired result under Countif column


For example, in value column if "2002Apple" is repeated twice in the whole range then it should give the value under Countif as 2.

In excel, we would write Countif(A:A,A2).Please could some one help me in writing the code in VBA for the desired result.

[pre]

A                   B              C             D
Value	             No          Product	Countif
2002Apple	    2002	   Apple	2
2002Apple	    2002	   Apple	2
2002Guava	    2002	   Grape	1
2002sweet	    2002	   sweet	1
2006Apple	    2006	   Apple	2
2006Juice	    2006	   Juice	1
2006Guava	    2006	   Guava	1
2006Apple	    2006	   Apple	1
2006sweet	    2006	   sweet	1
2007Apple	    2007	   Apple	1
2007Juice	    2007	   Juice	1

[/pre]

 

[Luke M]

It's fairly similar. Showing the entire code

[pre]

Sub FillData()
Dim i As Long
Dim LastRow As Long

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Application.ScreenUpdating = False
For i = 2 To LastRow
Cells(i, "D") = WorksheetFunction.CountIf(Range("A:A"), Cells(i, "A"))
Next
Application.ScreenUpdating = False
End Sub

[/pre]

 

[Alpana]

Thank you Luke.I was new to VBA - just in basic stage, so could not crack it ..thank you very much...

 

[Luke M]

Glad I could help, and let me welcome you to the world of VB. Hope you come to enjoy its benefits as much as I do. =)

 

[shrivallabha]

Hi Alpana,


VBA is fascinating to say the least. Here's one more way to implement your concept.

[pre]

Public Sub ImplementCountif()
Dim lLastRow As Long
Application.ScreenUpdating = False
lLastRow = Range("A" & Rows.Count).End(xlUp).Row
With Range("D2:D" & lLastRow)
.Formula = "=COUNTIF(A:A,A2)"
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub

[/pre]

 

[Alpana]

Thank you Shri..