VBA function to sum Cell which contain cell and text based on text criteria

[Alan_44]

Hi,

I am trying to add all the numbers that contain A, B, C and D... (project) The cells contains a mix of number and text. I would like to add all the numbers that contain, A, B, C etc. For example the result here should Project A =1, Project B=4, Project C=2

I have tried to make a VBA function like the one shown below based on something from the web, but getting stuck.

[TABLE="width: 500"]
<tbody>[TR]
[TD]3 B
[/TD]
[/TR]
[TR]
[TD]1A
[/TD]
[/TR]
[TR]
[TD]1B
[/TD]
[/TR]
[TR]
[TD]2 C
[/TD]
[/TR]
</tbody>[/TABLE]

Function CountProject(range_data As Range, criteria As Range) As Double
Dim datax As Range
Dim project As Double
project = criteria.text
CountProject = 0
For Each datax In range_data
If datax.text = project Then
ProjectCount = ProjectCount + Val(datax)
End If
Next datax
End Function

Please let me know if there is an elegant way to make this function work.

Thanks

Alan

 

[MickG]

Try this:-
NB:- Data assumed to be in single column !!

Function nStr(Rng [COLOR=navy]As[/COLOR] Range) [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range, Txt [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        Txt = Right(Dn.Value, 1)
            [COLOR=navy]If[/COLOR] Not .Exists(Txt) [COLOR=navy]Then[/COLOR]
                 .Add Txt, Val(Left(Dn.Value, Len(Dn.Value) - 1))
            [COLOR=navy]Else[/COLOR]
                .Item(Txt) = .Item(Txt) + Val(Left(Dn.Value, Len(Dn.Value) - 1))
            [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, Msg [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    Msg = Msg & K & "=" & .Item(K) & ", "
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
nStr = Msg
[COLOR=navy]End[/COLOR] Function

Regards Mick

 

[Alan_44]

Thanks a lot Mike! It works but I do not write the specification correctly. And yes the data are placed in a column. The function should have 2 arguments: a "range of data" and a "criteria". Please note that the text is not limited to 1 letter as shown in the corrected example below:[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD]A1contains "3 Bell"[/TD]
[/TR]
[TR]
[TD]A2contains "1Astra"[/TD]
[/TR]
[TR]
[TD]A3 contains "1Bell"[/TD]
[/TR]
[TR]
[TD]A4 contains "6 Caterpil"
The function should calculate the sum of number which has the same criteria. The function used a range, for example (A1:A4) and a criteria for example (Bell), the range and criteria being selected by the user. By entering the function in A5, it should show 4. If I change the criteria to Carterpil, it will show 6.
Hope that clarify my request [/TD]
[/TR]
</tbody>[/TABLE]

 

[Rick Rothstein]

See if this function does what you want...

[table="width: 500"]
[tr]
	[td]Function CountProject(DataRange As Range, Criteria As String) As Double
  Dim Cell As Range
  For Each Cell In DataRange
    If Cell.Value Like "*" & Criteria Then CountProject = CountProject + Val(Cell.Value)
  Next
End Function[/td]
[/tr]
[/table]

 

[Alan_44]

Thanks Rick ! It works and that what I needed !

 

[Alan_44]

Dear Rick,

This function has been working very well. I would like now to know if it will be possible to ignore some of the text contained in the same cell. For example Let say that a new Cell A4 contains "2 Bell Bike". I still would like the function to sum the number from the cell containing at least the criteria "Bell" regardless of the others text contain in the cell. In such case A1+A2+A3+A4=6 Any clue how to do that? I also would like to know if we could add a second criteria in the sum. For example let's say A5 contains "6 Bell Bike car". By selecting in the criteria "Bell" and "Bike", the sum of A1+A2+A3+A4+A5=8 Is it possible to have this in the same function?