# Need COUNTIF formula to be converted as a VBA code.

#### motilulla

##### Well-known Member
Hello,

Column "D" contains mix data, and unique values in the column "G".
Result count of unique values column "G", respect column "D" is shown in the column "H"

I am using the below "COUNTIF" formula in the cell H6 via VBA to fill the range down to H6 till end. But need a VBA code for faster calculation please help?

VBA Code:
``````Sub COUNTIF()
Range("H6:H48696").Formula = "=COUNTIF(\$D\$6:\$D\$4108,\$G6)"
End Sub``````

For more detail the image is attached here.

Thank you all.

I am using Excel 2000

Regards,
Moti

#### Attachments

• Countif in to VBA.png
32.3 KB · Views: 17

### Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

#### kweaver

##### Well-known Member

Try this on limited data (change column I to H after testing):

Code:
``````Sub dCount()
Dim lrg As Long, lrd As Long, i As Long, cr As Long
lrg = Cells(Rows.Count, "G").End(xlUp).Row
lrd = Cells(Rows.Count, "D").End(xlUp).Row

For i = 6 To lrg
cr = WorksheetFunction.CountIf(Range("D6:D" & lrd), Cells(i, "G"))
Cells(i, "I") = cr
Next i

End Sub``````

Book5
DEFGHI
671|122|30061|122|30000
771|122|30071|122|30022
869|72|31079|127|30900
969|72|31069|72|31044
1069|72|310
1169|72|310
Sheet5
Cell Formulas
RangeFormula
H6:H9H6=COUNTIF(\$D\$6:\$D\$11,G6)

Last edited:

#### motilulla

##### Well-known Member

Try this on limited data (change column I to H after testing):

Code:
``````Sub dCount()
Dim lrg As Long, lrd As Long, i As Long, cr As Long
lrg = Cells(Rows.Count, "G").End(xlUp).Row
lrd = Cells(Rows.Count, "D").End(xlUp).Row

For i = 6 To lrg
cr = WorksheetFunction.CountIf(Range("D6:D" & lrd), Cells(i, "G"))
Cells(i, "I") = cr
Next i

End Sub``````

Book5
DEFGHI
671|122|30061|122|30000
771|122|30071|122|30022
869|72|31079|127|30900
969|72|31069|72|31044
1069|72|310
1169|72|310
Sheet5
Cell Formulas
RangeFormula
H6:H9H6=COUNTIF(\$D\$6:\$D\$11,G6)
kweaver, I run your macro it is taking more time then what I got, I think but not sure VBA "With CreateObject("scripting.dictionary")" are more faster would you take a look please.

Note: regarding as far as I know it cannot be used with version 2000.

Kind Regards
Moti

#### kweaver

##### Well-known Member
I suspected that using COUNTIF in the VBA code would NOT improve the performance much, if at all, since it was calling the function that was the issue.

#### motilulla

##### Well-known Member

I suspected that using COUNTIF in the VBA code would NOT improve the performance much, if at all, since it was calling the function that was the issue.
kweaver, ok, any replacement with another formula, can improve the performance? if yes please suggest.

Kind Regards
Moti

#### kweaver

##### Well-known Member
I don't understand scripting.dictionary very well, so I'm not the person to help using that. I'm sure someone else will reply with a good and fast solution.

#### Alex Blakenburg

##### Well-known Member

Here is Fluff's code modified for this specific scenario.

I have commented the changes I made.
For some reason your data in this post doesn't align with your previous data (slightly different columns although same rows).

VBA Code:
``````Sub Count_Unique_Values()
Dim Ary As Variant, Nary As Variant
Dim r As Long

Ary = Range("D6:D" & Range("D" & Rows.Count).End(xlUp).Row).Value2       'xxx Changed from C:F to D:D
Nary = Range("G6", Range("G" & Rows.Count).End(xlUp)).Resize(, 2).Value2 'xxx Changed from I to G

With CreateObject("scripting.dictionary")
For r = 1 To UBound(Ary)
.Item(Ary(r, 1)) = .Item(Ary(r, 1)) + 1                            'xxx Changed to just sum 1 (effectively a count)
Next r
For r = 1 To UBound(Nary)
If .Exists(Nary(r, 1)) Then Nary(r, 2) = .Item(Nary(r, 1)) Else Nary(r, 2) = 0
Next r
End With
Range("G6").Resize(UBound(Nary), 2).Value = Nary                         'xxx Changed from I to G
End Sub``````

Last edited:

#### motilulla

##### Well-known Member
Hello Alex Blakenburg,

I apologise did not thought because this was "countif" and other were "Sumproduct" thank you for pointing out next time I will add the reference.

Here is Fluff's code modified for this specific scenario.

I have commented the changes I made.
For some reason your data in this post doesn't align with your previous data (slightly different columns although same rows).
I do appreciate your help it worked but I have an issue while changing the result column G2 to for example M2..."I am getting in M2 unique data duplicating column G" and result in the N2 i tried to modified but cannot got it work.

Please can you take a look?

Kind Regards,
Moti

#### Alex Blakenburg

##### Well-known Member
Are you able to provide an xl2bb ? With the data and an example of the expected result.

Column D is the source data. If you don't change that you will get the same results.

#### motilulla

##### Well-known Member
Are you able to provide an xl2bb ? With the data and an example of the expected result.

Column D is the source data. If you don't change that you will get the same results.
Hello Alex Blakenburg,

Regarding xl2bb, as far as I know it cannot use with version 2000. So far I have attached 2 images may help.

Image-A, if I run your code #post7 code getting results correct in the column H no problem.

Image-B, when I change result range in the VBA as below

This
VBA Code:
``Range("G6").Resize(UBound(Nary), 2).Value = Nary``

To this
Code:
``Range("I6").Resize(UBound(Nary), 2).Value = Nary``

You can see the Image-B; I get result in Col "J" and in the Col "I" duplicated of Col "G"

Hope this help

Kind Regards,
Moti

#### Attachments

• Image A.png
27.9 KB · Views: 9
• Image B.png
35.9 KB · Views: 6

Replies
1
Views
59
Replies
4
Views
87
Replies
5
Views
158
Replies
3
Views
184
Replies
3
Views
127

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

1,151,492
Messages
5,764,689
Members
425,230
Latest member
DzOus

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back