Need COUNTIF formula to be converted as a VBA code.

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,353
Office Version
  1. 2010
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
    Countif in to VBA.png
    32.3 KB · Views: 47
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")
 
Upvote 0

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
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
Please take a look.

*ABCDEFGHIJ
1
2Count Col DSum Col H
3240
4Data AResultResult
5Data ACount MatchesCount Data Col G
671 | 122 | 30061 | 122 | 300
771 | 122 | 30071 | 122 | 300
869 | 72 | 31079 | 127 | 309
969 | 72 | 310179 | 127 | 309
1069 | 72 | 31069 | 72 | 310
1169 | 72 | 310690 | 72 | 310
12111 | 89 | 99969 | 721 | 310
13111 | 89 | 999111 | 89 | 999
14111 | 89 | 999107 | 124 | 110
15111 | 89 | 999107 | 112 | 110
16111 | 89 | 999107 | 122 | 110
17107 | 12 | 110107 | 12 | 110
18107 | 12 | 110115 | 88 | 132
19107 | 12 | 110179 | 88 | 132
20107 | 12 | 110100 | 88 | 132
21107 | 12 | 11015 | 88 | 132
2215 | 88 | 132234 | 110 | 180
2315 | 88 | 132107 | 127 | 110
2415 | 88 | 132179 | 127 | 309
2515 | 88 | 13261 | 122 | 270
2615 | 88 | 132189 | 188 | 132
27234 | 110 | 180189 | 18 | 132
28234 | 110 | 180
29234 | 110 | 180
30
31


If you had made @kweaver aware of the code that you already from had @Fluff from a very similar previous question, he would most likely have been able to help you.

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:
Upvote 0
What is wrong with the code Alex provided in post#7?
 
Upvote 0
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
 
Upvote 0
How about
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
 
Upvote 0
Solution
How about
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 :)
 
Upvote 0
@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
 
Upvote 0
The problem with that approach is that it can return an error if the array is too large.
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,908
Members
448,532
Latest member
9Kimo3

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top