Need VBA, instead using formula

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,362
Office Version
  1. 2010
Hello,</SPAN>

I got data in column D, is currently filled with 6500 rows, in the column F I do got unique list within 62000 rows, in the G4 entered formula =COUNTIF($D$4:$D$10000,F4) when i copy down to end 62000 rows it takes long tine to count and after i need to convert them in values it take back to much time</SPAN></SPAN>

My request is it, do this task have any VBA solution </SPAN></SPAN>


Book1
DEFG
1
2
3DATAUNIQUE LISTCOUNT
41|0 = 0|1 = 1|1 = 1|0 = 0|1 = 1|0 = 0|10|0 = 0|0 = 0|0 = 0|1 = 0|2 = 0|2 = 0|20
51|0 = 0|2 = 0|1 = 2|0 = 0|2 = 2|0 = 0|00|0 = 0|0 = 0|0 = 0|1 = 0|2 = 0|2 = 1|10
61|0 = 0|0 = 2|0 = 0|2 = 2|0 = 0|0 = 2|00|1 = 0|0 = 1|0 = 0|0 = 1|1 = 1|0 = 2|01
71|0 = 0|1 = 0|1 = 1|0 = 1|0 = 0|1 = 0|10|0 = 0|0 = 0|0 = 0|1 = 0|2 = 1|1 = 0|20
81|0 = 1|0 = 1|0 = 1|0 = 0|0 = 1|0 = 1|00|0 = 0|0 = 0|0 = 0|1 = 0|2 = 1|1 = 1|10
92|0 = 1|0 = 0|0 = 1|0 = 1|0 = 0|1 = 1|10|0 = 0|0 = 0|0 = 0|1 = 0|2 = 1|1 = 2|00
101|1 = 0|0 = 0|1 = 2|0 = 1|0 = 0|0 = 0|10|0 = 0|0 = 0|0 = 0|1 = 0|2 = 2|0 = 0|20
111|0 = 2|0 = 0|0 = 0|0 = 0|0 = 1|0 = 0|00|1 = 0|0 = 0|2 = 0|2 = 0|0 = 0|0 = 1|11
121|0 = 1|0 = 0|1 = 0|1 = 0|0 = 1|1 = 1|10|0 = 0|0 = 0|0 = 0|1 = 0|2 = 2|0 = 2|00
131|1 = 1|0 = 1|0 = 0|0 = 0|0 = 1|0 = 1|00|0 = 0|0 = 0|0 = 0|1 = 1|1 = 0|2 = 0|20
140|0 = 0|0 = 0|0 = 2|0 = 1|0 = 0|0 = 1|10|0 = 0|0 = 0|0 = 0|1 = 1|1 = 0|2 = 1|10
150|1 = 0|1 = 1|0 = 0|1 = 1|1 = 0|0 = 1|00|0 = 0|0 = 0|0 = 0|1 = 1|1 = 0|2 = 2|00
161|0 = 1|0 = 0|1 = 2|0 = 1|0 = 0|0 = 1|00|0 = 0|0 = 0|0 = 0|1 = 1|1 = 1|1 = 0|20
171|0 = 1|0 = 0|1 = 0|0 = 0|2 = 1|0 = 0|00|0 = 0|0 = 0|0 = 0|1 = 1|1 = 1|1 = 1|10
180|0 = 1|0 = 0|0 = 0|0 = 1|0 = 0|0 = 0|00|0 = 0|0 = 0|0 = 0|1 = 1|1 = 1|1 = 2|00
191|0 = 1|1 = 0|0 = 0|1 = 1|0 = 0|1 = 2|00|0 = 1|0 = 1|0 = 0|0 = 0|0 = 1|0 = 0|01
200|0 = 1|0 = 1|0 = 1|0 = 1|0 = 0|0 = 0|00|0 = 0|0 = 0|0 = 0|1 = 1|1 = 2|0 = 1|10
210|0 = 0|0 = 1|0 = 1|1 = 0|0 = 0|0 = 0|10|0 = 0|0 = 0|0 = 0|1 = 1|1 = 2|0 = 2|00
220|0 = 0|0 = 0|0 = 0|0 = 0|0 = 1|1 = 1|00|0 = 0|0 = 0|0 = 0|1 = 2|0 = 0|2 = 0|20
230|1 = 0|1 = 0|0 = 0|0 = 0|0 = 1|0 = 0|00|0 = 0|0 = 0|0 = 0|1 = 2|0 = 0|2 = 1|10
240|0 = 1|0 = 0|0 = 0|0 = 0|0 = 0|0 = 0|10|0 = 0|0 = 0|0 = 0|1 = 2|0 = 0|2 = 2|00
252|0 = 1|0 = 0|0 = 1|0 = 0|1 = 1|0 = 0|00|0 = 0|0 = 0|0 = 0|1 = 2|0 = 1|1 = 0|20
261|1 = 0|0 = 0|1 = 0|0 = 0|0 = 2|0 = 1|00|0 = 0|0 = 0|0 = 0|1 = 2|0 = 1|1 = 1|10
271|0 = 0|2 = 0|0 = 0|1 = 2|0 = 0|0 = 1|00|0 = 0|0 = 0|0 = 0|1 = 2|0 = 1|1 = 2|00
280|1 = 2|0 = 0|0 = 2|0 = 1|0 = 0|0 = 0|00|0 = 0|0 = 0|0 = 0|1 = 2|0 = 2|0 = 0|20
291|0 = 0|1 = 0|1 = 0|0 = 0|1 = 0|0 = 1|00|0 = 0|0 = 0|0 = 0|1 = 2|0 = 2|0 = 1|10
300|0 = 1|0 = 0|2 = 0|1 = 1|0 = 1|0 = 1|00|0 = 0|0 = 0|0 = 0|1 = 2|0 = 2|0 = 2|00
310|1 = 1|0 = 1|0 = 1|0 = 0|0 = 0|0 = 0|00|0 = 0|0 = 0|0 = 0|2 = 0|1 = 0|2 = 0|20
321|0 = 0|0 = 0|0 = 0|1 = 1|1 = 1|0 = 2|00|0 = 0|0 = 0|0 = 0|2 = 0|1 = 0|2 = 1|10
330|1 = 0|0 = 1|0 = 0|0 = 1|1 = 1|0 = 2|00|0 = 0|0 = 0|0 = 0|2 = 0|1 = 0|2 = 2|00
341|0 = 0|0 = 1|0 = 0|1 = 0|0 = 1|0 = 2|00|0 = 0|0 = 0|0 = 0|2 = 0|1 = 1|1 = 0|20
351|1 = 0|0 = 1|0 = 1|0 = 1|0 = 0|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 0|1 = 1|1 = 1|10
361|0 = 1|1 = 1|0 = 0|0 = 0|0 = 0|1 = 1|00|0 = 2|0 = 1|0 = 0|0 = 2|0 = 1|1 = 0|01
371|0 = 2|0 = 1|0 = 0|0 = 1|0 = 0|2 = 0|00|0 = 0|0 = 0|0 = 0|2 = 0|1 = 2|0 = 0|20
381|0 = 1|0 = 1|1 = 0|0 = 1|0 = 1|0 = 0|10|0 = 0|0 = 0|0 = 0|2 = 0|1 = 2|0 = 1|10
391|0 = 0|0 = 1|0 = 2|0 = 0|1 = 0|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 0|1 = 2|0 = 2|00
400|1 = 0|0 = 0|0 = 1|0 = 2|0 = 1|0 = 0|20|0 = 0|0 = 0|0 = 0|2 = 0|2 = 0|1 = 0|20
411|0 = 0|0 = 0|0 = 0|0 = 0|1 = 0|2 = 1|00|0 = 0|0 = 0|0 = 0|2 = 0|2 = 0|1 = 1|10
421|1 = 1|0 = 1|0 = 0|0 = 2|0 = 2|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 0|2 = 0|1 = 2|00
431|1 = 0|0 = 1|0 = 0|1 = 0|0 = 0|0 = 0|10|0 = 0|0 = 0|0 = 0|2 = 0|2 = 0|2 = 0|10
441|0 = 1|0 = 0|0 = 0|0 = 0|0 = 1|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 0|2 = 0|2 = 1|00
452|0 = 0|0 = 1|0 = 1|1 = 0|0 = 0|0 = 2|00|0 = 0|0 = 0|0 = 0|2 = 0|2 = 1|0 = 0|20
460|0 = 1|0 = 1|0 = 0|0 = 0|0 = 1|0 = 0|02|0 = 0|0 = 1|0 = 0|0 = 0|0 = 0|0 = 0|01
472|0 = 0|0 = 1|0 = 0|0 = 0|0 = 0|0 = 0|00|0 = 0|0 = 0|0 = 0|2 = 0|2 = 1|0 = 2|00
480|0 = 1|0 = 0|0 = 0|0 = 0|1 = 1|0 = 0|00|0 = 0|0 = 0|0 = 0|2 = 0|2 = 1|1 = 0|10
490|0 = 0|0 = 1|0 = 1|0 = 1|1 = 2|0 = 2|00|0 = 0|0 = 0|0 = 0|2 = 0|2 = 1|1 = 1|00
500|0 = 0|0 = 0|1 = 2|0 = 1|0 = 0|0 = 0|00|0 = 0|0 = 0|0 = 0|2 = 0|2 = 2|0 = 0|10
511|1 = 0|0 = 1|0 = 1|0 = 1|0 = 0|0 = 0|10|0 = 0|0 = 0|0 = 0|2 = 0|2 = 2|0 = 1|00
521|0 = 1|0 = 0|0 = 0|0 = 0|1 = 0|1 = 0|10|0 = 0|0 = 0|0 = 0|2 = 1|0 = 0|2 = 0|20
530|0 = 0|0 = 1|0 = 1|0 = 2|0 = 0|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 1|0 = 0|2 = 1|10
541|0 = 0|0 = 1|0 = 0|1 = 0|0 = 1|1 = 0|00|0 = 0|0 = 0|0 = 0|2 = 1|0 = 0|2 = 2|00
550|0 = 2|0 = 1|0 = 0|0 = 2|0 = 1|1 = 0|00|0 = 0|0 = 0|0 = 0|2 = 1|0 = 1|1 = 0|20
560|1 = 0|1 = 0|0 = 1|1 = 1|0 = 2|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 1|0 = 1|1 = 1|10
570|0 = 1|0 = 0|1 = 0|0 = 0|0 = 1|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 1|0 = 1|1 = 2|00
580|1 = 0|1 = 1|0 = 0|0 = 0|0 = 1|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 1|0 = 2|0 = 0|20
590|0 = 0|0 = 0|1 = 1|0 = 0|2 = 1|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 1|0 = 2|0 = 1|10
600|1 = 1|0 = 0|0 = 1|0 = 0|0 = 2|0 = 1|10|0 = 0|0 = 0|0 = 0|2 = 1|0 = 2|0 = 2|00
610|0 = 0|0 = 1|0 = 1|0 = 0|0 = 0|1 = 0|10|0 = 0|0 = 0|0 = 0|2 = 1|1 = 0|1 = 0|20
620|0 = 0|0 = 0|0 = 0|1 = 0|1 = 0|0 = 1|00|0 = 0|0 = 0|0 = 0|2 = 1|1 = 0|1 = 1|10
630|1 = 0|0 = 0|2 = 0|2 = 0|0 = 0|0 = 1|10|0 = 0|0 = 0|0 = 0|2 = 1|1 = 0|1 = 2|00
Sheet1
Cell Formulas
RangeFormula
G4=COUNTIF($D$4:$D$10000,F4)


Thank you all</SPAN></SPAN>
Excel 2000</SPAN></SPAN>
Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Just tested the original code from lrobbo314 in Xl2003 & it works for me.
Fluff, yes I am sure it is version not a code, I did post#7 tried your modified version and it is also giving an error 13</SPAN></SPAN>
 
Upvote 0

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
I've now tested both codes in 2003 with col F down to row 62,000 & they both work fine.
So not sure what the problem is.
 
Upvote 0
I've now tested both codes in 2003 with col F down to row 62,000 & they both work fine.
So not sure what the problem is.
Fluff, really thank you for testing them, I have tried all the way including creating new workbook but no luck. </SPAN></SPAN>

I have one more question is it possible your code which is in the post#2, working fine for me. Please can you modified so this could work in the following scenario</SPAN></SPAN>. "If DATA in column D are in sheet1", and the "UNIQUE & Count columns, F & G are in sheet2".

Kind Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Last edited:
Upvote 0
Try
Code:
Sub MyCountif()
   With Sheets("Sheet2").Range("G4", Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp).Offset(, 1))
      .Value = Sheets("Sheet1").Evaluate("if({1},countif($D$4:$D$10000," & .Offset(, -1).Address & "))")
   End With
End Sub
 
Upvote 0
Try
Code:
Sub MyCountif()
   With Sheets("Sheet2").Range("G4", Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp).Offset(, 1))
      .Value = Sheets("Sheet1").Evaluate("if({1},countif($D$4:$D$10000," & .Offset(, -1).Address & "))")
   End With
End Sub
Fluff, God knows what is wrong, when all is very simple broken my head but strange situation code count results are "0" I tried to run the code selecting sheet1 or from sheet2 but no luck, if I run the code post#2 when data are in the same sheet no problem.</SPAN></SPAN>

Cannot figure what I am doing wrong?</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Upvote 0
Are the sheet names correct & did you get any error messages?
 
Upvote 0
Missed a bit
Code:
Sub MyCountif()
   With Sheets("Sheet2").Range("G4", Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp).Offset(, 1))
      .Value = Sheets("Sheet1").Evaluate("if({1},countif($D$4:$D$10000," & .Offset(, -1).Address[COLOR=#0000ff](, , , True)[/COLOR] & "))")
   End With
End Sub
It originally worked for me as I still had all the data on sheet1
 
Upvote 0
Missed a bit
Code:
Sub MyCountif()
   With Sheets("Sheet2").Range("G4", Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp).Offset(, 1))
      .Value = Sheets("Sheet1").Evaluate("if({1},countif($D$4:$D$10000," & .Offset(, -1).Address[COLOR=#0000ff](, , , True)[/COLOR] & "))")
   End With
End Sub
It originally worked for me as I still had all the data on sheet1
Fluff, this worked like magic 2092 rows in sheet1 and 54246 rows in sheet2 and took time only 8,73 sec to finish, it is really amazing!!</SPAN></SPAN>

Thank you for your kind helps & time you spent to solve it as request</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti :)</SPAN></SPAN>
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,215,339
Messages
6,124,362
Members
449,155
Latest member
ravioli44

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