# 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

#### Alex Blakenburg

##### Well-known Member
I am not sure I am understanding what you are trying to do but you might want to change this line from G to I as well.
VBA Code:
``   Nary = Range("G6", Range("G" & Rows.Count).End(xlUp)).Resize(, 2).Value2 'xxx Changed from I to G``

Change to
VBA Code:
``   Nary = Range("I6", Range("I" & Rows.Count).End(xlUp)).Resize(, 2).Value2``

The code as it stands assumes that you already have a list of items in "G" (and I assume now also in "I")

### Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

#### motilulla

##### Well-known Member
I am not sure I am understanding what you are trying to do but you might want to change this line from G to I as well.
VBA Code:
``   Nary = Range("G6", Range("G" & Rows.Count).End(xlUp)).Resize(, 2).Value2 'xxx Changed from I to G``

Change to
VBA Code:
``   Nary = Range("I6", Range("I" & Rows.Count).End(xlUp)).Resize(, 2).Value2``

The code as it stands assumes that you already have a list of items in "G" (and I assume now also in "I")
Hello Alex Blakenburg, i am disturbing due not to providing a sheet but another way I am pasting here sheet May that you can copy? If yes then please run your code #post7 just changing the line below and see the result. What I mean to say in the image-B attached #post 10

 * A B C D E F G H I J 1 2 Count Col D Sum Col H 3 24 0 4 Data A Result Result 5 Data A Count Matches Count Data Col G 6 71 | 122 | 300 61 | 122 | 300 7 71 | 122 | 300 71 | 122 | 300 8 69 | 72 | 310 79 | 127 | 309 9 69 | 72 | 310 179 | 127 | 309 10 69 | 72 | 310 69 | 72 | 310 11 69 | 72 | 310 690 | 72 | 310 12 111 | 89 | 999 69 | 721 | 310 13 111 | 89 | 999 111 | 89 | 999 14 111 | 89 | 999 107 | 124 | 110 15 111 | 89 | 999 107 | 112 | 110 16 111 | 89 | 999 107 | 122 | 110 17 107 | 12 | 110 107 | 12 | 110 18 107 | 12 | 110 115 | 88 | 132 19 107 | 12 | 110 179 | 88 | 132 20 107 | 12 | 110 100 | 88 | 132 21 107 | 12 | 110 15 | 88 | 132 22 15 | 88 | 132 234 | 110 | 180 23 15 | 88 | 132 107 | 127 | 110 24 15 | 88 | 132 179 | 127 | 309 25 15 | 88 | 132 61 | 122 | 270 26 15 | 88 | 132 189 | 188 | 132 27 234 | 110 | 180 189 | 18 | 132 28 234 | 110 | 180 29 234 | 110 | 180 30 31

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[/B][/COLOR]
End Sub``````
Just changing the above line Range("G6").Resize(UBound(Nary), 2).Value = Nary To This below one

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

Kind Regards
Moti

Last edited:

#### Fluff

##### MrExcel MVP, Moderator
What is wrong with the code Alex provided in post#7?

#### motilulla

##### Well-known Member
What is wrong with the code Alex provided in post#7?
Fluff, as he mentioned in his post#7 he modified your pervious code as per need shown in my post#1 which worked fine no complaint at all I did appreciate his help. As later I wanted result in the column "I" instead of column "G" I just change the bottom line

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

To this for result in the column "I" insted of column "G"
Range("I6").Resize(UBound(Nary), 2).Value = Nary``````

After the change when running the code getting result in column "J" and in column "I" getting Column "G" copied.

I need a modification to get only the result in column "I" May it is simple but could not explained it well.

Please can you copy data from post#12 and run the code post#7 it will make clearer.

Thank you very much

Kind Regards,
Moti

#### Fluff

##### MrExcel MVP, Moderator

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

Ary = Range("D6", Range("D" & Rows.Count).End(xlUp)).Value2
Nary = Range("G6", Range("G" & Rows.Count).End(xlUp)).Value2
ReDim Oary(1 To UBound(Nary), 1 To 1)

With CreateObject("scripting.dictionary")
For r = 1 To UBound(Ary)
.Item(Ary(r, 1)) = .Item(Ary(r, 1)) + 1
Next r
For r = 1 To UBound(Nary)
If .Exists(Nary(r, 1)) Then Oary(r, 1) = .Item(Nary(r, 1)) Else Oary(r, 1) = 0
Next r
End With
Range("I6").Resize(UBound(Nary)).Value = Oary
End Sub``````

#### motilulla

##### Well-known Member
VBA Code:
``````Sub motilulla()
Dim Ary As Variant, Nary As Variant, Oary As Variant
Dim r As Long

Ary = Range("D6", Range("D" & Rows.Count).End(xlUp)).Value2
Nary = Range("G6", Range("G" & Rows.Count).End(xlUp)).Value2
ReDim Oary(1 To UBound(Nary), 1 To 1)

With CreateObject("scripting.dictionary")
For r = 1 To UBound(Ary)
.Item(Ary(r, 1)) = .Item(Ary(r, 1)) + 1
Next r
For r = 1 To UBound(Nary)
If .Exists(Nary(r, 1)) Then Oary(r, 1) = .Item(Nary(r, 1)) Else Oary(r, 1) = 0
Next r
End With
Range("I6").Resize(UBound(Nary)).Value = Oary
End Sub``````
Fluff, yes it worked even I tried changing the range I, Q, R, S it worked perfect!

Thank you for updating it. Have a nice day. Good Luck

And also thanks to everyone for assisting with this project!

Kind Regards,
Moti

#### Fluff

##### MrExcel MVP, Moderator

Glad we could help & thanks for the feedback.

#### Alex Blakenburg

##### Well-known Member
@Fluff - FYI - using the original code without introducing a 3rd array, as far as I can tell simply replacing the output line with the below would have worked. (I would not have even have gone looking for this without you having solved the issue first though)

VBA Code:
``    Range("I6").Resize(UBound(Nary)).Value = Application.Index(Nary, , 2)``

Source: Useful Gyaan - Slicing an Array without loop

#### Fluff

##### MrExcel MVP, Moderator
The problem with that approach is that it can return an error if the array is too large.

#### Alex Blakenburg

##### Well-known Member
The problem with that approach is that it can return an error if the array is too large.
For my future reference, do you have an idea of the order of magnitude at which it starts to have issues ?

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