VBA - Collection help..

[malleshg24]

Hi Team,

Please assist need help in collection,
I am just trying to replace Autofilter/advanced filter and taking Count via Class module and Collection.

Assist in merging Seperate loop into Single Loop in my attached workbook.
and any tips if my criteria increases, Thanks in advance for your help.


Below Code gives Correct result.

Dim i As Long
For i = 2 To lr
name = Sheet1.Cells(i, 1).Value
Score = Sheet1.Cells(i, 3).Value
If IsNumeric(Application.Match(name, LCountry, 0)) And Score >= 400 Then
Set c = New Class1
c.str = Range("A" & i).Value
Coll.Add c
End If
Next i
Range("i3").Value = Coll.Count




Thanks
mg.

[Leith Ross]

Hell Malleshg24,

The problem is with the cCustomer Class. Here is the working code and workbook.



Option Explicit


Dim pvtName As String
Dim pvtCity As String
Dim pvtSales As String


Property Let Name(ByVal Cust_Name As String)
pvtName = Cust_Name
End Property


Property Get Name() As String
Name = pvtName
End Property


Property Let City(ByVal City_Name As String)
pvtCity = City_Name
End Property


Property Get City() As String
City = pvtCity
End Property


Property Let Sales(ByVal Sales_Amount As String)
pvtSales = Sales_Amount
End Property


Property Get Sales() As String
Sales = pvtSales
End Property

[malleshg24]

Hi Leith,

Thank you so much for your help,
Actually mistakenly I was attached wrong input file, reattached correct input file now , including my attempted code,

Is it possible to shorten my code.?... Thanks in advance.




Thanks
mg

[Leith Ross]

Hello Malleshg24,

Your new code does not need a Class object nor does it really need VBA to generate the results. What is your thinking behind using these two approaches?

[malleshg24]

Hi Leith,

I am using same loop multiple times to get the Count for different Country,
Can we merge it into a single loop.

Dim Coll As New Collection
Dim c As Class1


Dim LCountry As Variant
LCountry = Array("London", "Ldn")


Dim HKCountry As Variant
HKCountry = Array("HK", "TK")




Dim name As String
Dim Score As Long


Dim lr As Long
lr = Range("a1").CurrentRegion.Rows.Count

Dim i As Long
For i = 2 To lr
name = Sheet1.Cells(i, 1).Value
Score = Sheet1.Cells(i, 3).Value
If IsNumeric(Application.Match(name, LCountry, 0)) And Score >= 400 Then
Set c = New Class1
c.str = Range("A" & i).Value
Coll.Add c
End If
Next i
Range("i3").Value = Coll.Count

' Set c = Nothing
' Set Coll = Nothing
'


'HK/TK Country Count in Range("j3"
Dim HColl As New Collection
For i = 2 To lr
name = Sheet1.Cells(i, 1).Value
Score = Sheet1.Cells(i, 3).Value
If IsNumeric(Application.Match(name, HKCountry, 0)) And Score >= 400 Then
Set c = New Class1
c.str = Range("A" & i).Value
HColl.Add c
End If
Next i
Range("J3").Value = HColl.Count


Thanks
mg

[mana]

Why don't you use Countifs function?


Option Explicit

Sub test()
Dim dic As Object
Dim v, i As Long, k As String
Dim c As Range, e, n As Long
Const target As Long = 400

Set dic = CreateObject("scripting.dictionary")
v = Sheet1.Cells(1).CurrentRegion.Value

For i = 2 To UBound(v)
k = v(i, 1)
If v(i, 3) >= target Then dic(k) = dic(k) + 1
Next

For Each c In Sheet1.Cells(7).CurrentRegion.Rows(2).Cells
For Each e In Split(c.Value, "/")
n = n + dic(e)
Next
c.Offset(1).Value = n
Next

End Sub

[Paul_Hossler]

I'd use a simple user defined function


25372




Option Explicit


Function CountryCounts(Data As Range, Country As String, Optional Score As Double = 400#) As Long
Dim n As Long, r As Long
Dim vData As Variant
Dim sCountry As String

vData = Data

For r = LBound(vData, 1) + 1 To UBound(vData, 1)
vData(r, 1) = UCase(vData(r, 1))
Next r


sCountry = UCase(Country)

For r = LBound(vData, 1) + 1 To UBound(vData, 1)
If vData(r, 1) = sCountry And vData(r, 3) >= Score Then n = n + 1
Next r

CountryCounts = n




End Function

[SamT]

A No VBA example attached

[Paul_Hossler]

OP's requirements little unclear, but I thought they were asking to get the number of times (e.g.) there was a LONDON entry > 400, not the sum of the entries over 400

[malleshg24]

Hi Team,

Thank you all for your help :thumbfor suggesting different ways of doing the task, I will adjust as per my requirement.
it was my mistake , Firstly I have attached wrong input file and later I reattached correct input file.
Correct file name was VBA Collection help.xlsm .


Thanks.
mg