Need COUNTIF formula to be converted as a VBA code.

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,073
Office Version
  1. 2003 or older
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: 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
Joined
May 8, 2018
Messages
2,177
Office Version
  1. 365
  2. 2010
If you use XL2BB anyone trying to help you won't have to retype your sample data.

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
Joined
Feb 13, 2008
Messages
2,073
Office Version
  1. 2003 or older
If you use XL2BB anyone trying to help you won't have to retype your sample data.

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.

I appreciate your help

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

Kind Regards
Moti
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
2,177
Office Version
  1. 365
  2. 2010
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
Joined
Feb 13, 2008
Messages
2,073
Office Version
  1. 2003 or older

ADVERTISEMENT

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
Joined
May 8, 2018
Messages
2,177
Office Version
  1. 365
  2. 2010
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
Joined
Feb 23, 2021
Messages
2,630
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
End Sub
 
Last edited:

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,073
Office Version
  1. 2003 or older
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.
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
Joined
Feb 23, 2021
Messages
2,630
Office Version
  1. 365
Platform
  1. Windows
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
Joined
Feb 13, 2008
Messages
2,073
Office Version
  1. 2003 or older
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
    Image A.png
    27.9 KB · Views: 9
  • Image B.png
    Image B.png
    35.9 KB · Views: 6
Learn Excel from Bill Jelen

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

Forum statistics

Threads
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.
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
Top