I have a single column of data in Column A that looks like this:
Joe
Joe
Joe
John
John
Josh
Josh
Josh
Josh
Can someone please provide me with code that would sum the number of Joes, Johns, and Joshs and put the sum for each name in the adjacement column. Thank you in advance! Huge help.. I have 5000 rows of names
[Note]
The meaning of the question has been change. My answer refer to the original version of question.
You can use Dictionary class to get count of each name in a string. Please, see:
'needs reference to Sctipting Runtime dll
Sub DoSomething()
Dim s As String, result() As String
Dim i As Integer, counter As Integer
Dim dic As Dictionary, k As Variant
s = "Joe Joe Joe John John Josh Josh Josh Josh"
result = Split(s, " ")
Set dic = New Dictionary
With dic
.CompareMode = BinaryCompare
For i = LBound(result) To UBound(result)
If Not .Exists(result(i)) Then
.Add Key:=result(i), Item:=1
Else
k = dic(result(i))
dic(result(i)) = k + 1
End If
Next
End With
For Each k In dic.Keys
Debug.Print k, dic(k)
Next
Set dic = Nothing
End Sub
Result:
Joe 3
John 2
Josh 4
[EDIT]
As to the changed question, you have to change only one loop. instead of:
For i = LBound(result) To UBound(result)
'
Next
use:
'earlier (variable declaration section):
Dim wsh As Worksheet
'later:
Set wsh = Thisworkbook.Worksheets("SheetName")
i = 2
Do While wsh.Range("A" & i) <>""
If Not .Exists(wsh.Range("A" & i)) Then
.Add Key:=wsh.Range("A" & i), Item:=1
Else
k = dic(wsh.Range("A" & i))
dic(wsh.Range("A" & i)) = k + 1
End If
i = i +1
Loop
Final note:
I'd suggest to move your focus on array formula, which enables you to make any calculation.
Steps to do (MS Excel 2010 and higher):
1) Copy column A into new Sheet
2) Remove duplicates (use Menu)
3) Select column B and insert the following formula:
=SUM(IF((Sheet1!$A$1:$A$1000=$A1), 1, 0))
4) Accept fomula by pressing CTRL + SHIFT + ENTER
Related
So i have data which looks like this:
Name
Title
Salutation
Doe
Mr J & Mrs E
John & Elaine
Smith
Mr K & Mrs M
Ken & Margaret
Jones
Mr R
Bob
I need to identify the rows which contain Mr & Mrs and give them each their own row. So I want it to look like this:
Name
Title
Salutation
Doe
Mr J
John
Doe
Mrs E
Elaine
Smith
Mr K
Ken
Smith
Mrs M
Margaret
Jones
Mr R
Bob
Please could someone help with some code to do this?
The solution below is coded for your three columns to be in Columns A, B, and C. This loop works up from the bottom of your data to make it easier to deal with the inserted row.
Sub split_rows()
Dim s As Worksheet
Dim r As Long
Dim title_position As Integer
Dim saluation_position As Integer
Dim title As String
Dim salutation As String
Dim last_row As Long
Const name_column = 1
Const title_column = 2
Const salutation_column = 3
Set s = ActiveSheet 'use the line to process the active sheet
'set s = worksheets("Sheet1") ' use this line to process a specific sheet
' this loop works from the bottom of the worksheet up.
' the code is simpler that working top-down.
last_row = s.Cells(s.Rows.Count, title_column).End(xlUp).Row
For r = last_row To 2 Step -1
Debug.Print s.Cells(r, 1).Value
title_position = InStr(1, s.Cells(r, title_column).Value, "&")
saluation_position = InStr(1, s.Cells(r, salutation_column).Value, "&")
If title_position > 0 And saluation_position > 0 Then
' found ampersands in title and salution, let's to split the data
'put joint title and salutation values in variables to make the code easier to read
title = s.Cells(r, title_column).Value
salutation = s.Cells(r, salutation_column).Value
s.Rows(r).Insert ' add a row
' put the the name (unchanged) in the new row
s.Cells(r, name_column).Value = s.Cells(r + 1, name_column).Value
' put half the title in each row
s.Cells(r, title_column).Value = Trim(Split(title, "&")(0))
s.Cells(r + 1, title_column).Value = Trim(Split(title, "&")(1))
' put half the salutation in each row
s.Cells(r, salutation_column).Value = Trim(Split(salutation, "&")(0))
s.Cells(r + 1, salutation_column).Value = Trim(Split(salutation, "&")(1))
End If
Next
End Sub
I need to find the average of a number found in column F if a particular value is found in any of the other columns in the sheet.
For instance: I have the following in a range...
A B C D E F
Red Bill Jack Ruby Bill 250
Blue Ruby Ivan Raul Ted 350
Green Ted James Rick Ted 125
Red Ted Phil Ruby Bill 300
And in this worksheet, I want to find any instance of the name Bill and get the average of the number found in column F. In this case, the answer of 275 because Bill's name shows up in two rows. In the same respect, If I choose to look at Ted's numbers, the answer should be 258 because Ted's name shows up in three rows.
I would also appreciate if the formula would ignore any blank cells in the process of calculating the answer.
Thanks in advance!
I would use the function below, assuming that the data is placed in Sheet1.
Function my_average(strName As String) As Variant
Dim varArrayNames As Variant
Dim varValues As Variant
Dim dblInSum(1 To 4) As Double '~~> change to "1 To 40"
Dim lngCnt As Long
Dim strRow As String
Dim dblSum As Double
varArrayNames = Sheet1.Range("B1:E4").Value '~~> change to "B1:G40"
varValues = Sheet1.Range("F1:F4").Value '~~> change to "H1:H40"
For lngCnt = LBound(varArrayNames, 1) To UBound(varArrayNames, 1)
strRow = Join(WorksheetFunction.Index(varArrayNames, lngCnt, 0))
If InStr(strRow, strName) > 0 Then
dblInSum(lngCnt) = 1
End If
Next lngCnt
dblSum = WorksheetFunction.Sum(dblInSum)
If dblSum > 0 Then
my_average = WorksheetFunction.SumProduct(dblInSum, Application.Transpose(varValues)) / dblSum
Else
my_average = 0
End If
End Function
Testing:
Place =my_average("Bill") in any workbook (or a cell reference instead of "Bill").
Formulas:
Results:
Assuming the lookup value (Bill etc) is in cell C7, add the following formula in G1 then copy down for other rows.
=IF(ISERROR(MATCH($C$7,A1:E1,0)),"",F1)
Then do
=AVERAGE(G1:G4)
So if Bill is in any col a-e that number is taking into the ave... If so depending on your data size why not do this simply...:
Sub simplesearch()
cnt = 0
tot = 0
srchval = InputBox("What are we looking for?")
lr = Range("A1000000").End(xlUp).Row
For i = 1 To lr
For j = 1 To 5
If Cells(i, j).Value = srchval Then
tot = tot + Cells(i, 6).Value
cnt = cnt + 1
End If
Next j
Next i
If Not (cnt = 0) Then
MsgBox (tot / cnt)
Else
MsgBox ("0")
End If
End Sub
I am looking to count the unique entries in a column in excel
counting only the ones with the highest date for that entry
that have a specific value
the below is an example
a b c
111 01/01/2015 dave
121 01/12/2015 hayley
114 01/01/2015 james
111 01/12/2015 john
131 01/06/2015 peter
114 01/12/2015 james
192 01/01/2015 scooby
So for 111 I only want to count entry against john
114 are both against James but I only want to count the 01/12/2015 entry
I am interested in how many unique entries each person has where the latest entry is against that person
As I stated in the comments, I do not believe it is possible without vba. Here is a User Defined Function.
Function countmax(nme As Range, cntrng As Range) As String
Dim a As String
Dim b As String
Dim t
Dim temp As Integer
Dim arr
arr = cntrng.Value2
With cntrng
a = Range(Cells(.Row, Columns(1).Column), Cells(.Rows(.Rows.Count).Row, Columns(1).Column)).Address
b = Range(Cells(.Row, Columns(2).Column), Cells(.Rows(.Rows.Count).Row, Columns(2).Column)).Address
End With
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 3) = nme Then
t = Evaluate("= MAX(IF(" & a & "=" & Cells(i, 1).Address & "," & b & "))")
If arr(i, 1) & t = arr(i, 1) & arr(i, 2) Then
temp = temp + 1
End If
End If
Next i
countmax = temp
End Function
It needs to be placed in a macro page tied to the workbook.
From Excel hit Alt-F11. In that window goto Insert ==> Module. Into that module paste the above code.
Here is a better explanation with pictures.
It can be called directly from the worksheet. For example if the list of names is in E2:E7 then in F2 put:
=countmax(E2,$A$1:$C$7)
For dave it would return 0 all the others would get 1.
If you pasted the code in another workbook like the personal.xlsb then you need to preface the call:
=PERSONAL.XLSB!countmax(E2,$A$1:$C$7)
I have an excel set for which I need to count entries based on names. They're all in the same column and there is supposed to be 4 of each entry. I need a formula to count the number of cells with the same entry that do NOT start with either "Retail" or "Commercial" and only return the names in the cells for which there is NOT 4. For example, if my data looks thusly:
NAME
Retail - John
Retail - Sue
Kara
Kara
Joe
Joe
Joe
Joe
Commercial
Sarah
I want a formula that will search this column, and only return "Kara - 2" and "Sarah - 1". The "Retail" and "Commercial" are excluded from the start and since "Joe"=4 I'm not concerned with that. Is there some way I can have this search the column, have it return the first count to meet that criteria to C1, the next one to C2 and so on until I have a column of just the non-compliant entries? I'd love an output like below:
NAME COUNT
Kara 2
Sarah 1
Thanks for looking, I really appreciate any help and advice you can offer!
If your data is in column A the results table will be in columns B & C after running this macro:
Sub MAIN()
Dim A As Range, wf As WorksheetFunction
Dim s1 As String, s2 As String
Dim col As Collection
Set A = Intersect(Range("A:A"), ActiveSheet.UsedRange)
Set wf = Application.WorksheetFunction
Set col = MakeColl(A)
s1 = "Retail"
s2 = "Commercial"
K = 1
For i = 1 To col.Count
v = col.Item(i)
If InStr(v, s1) = 0 And InStr(v, s2) = 0 Then
n = wf.CountIf(A, v)
If n <> 4 Then
Cells(K, "B").Value = v
Cells(K, "C").Value = n
K = K + 1
End If
End If
Next i
End Sub
Public Function MakeColl(rng As Range) As Collection
Set MakeColl = New Collection
Dim r As Range
On Error Resume Next
For Each r In rng
v = r.Value
If v <> "" Then
MakeColl.Add v, CStr(v)
End If
Next r
MsgBox MakeColl.Count
End Function
I have an Excel sheet with a list of addresses on each line
i.e.
COLUMN A
My Company 123 Big Street Ashgrove QLD 4111
A Better Compant PO Box 123 Sandgate QLD 4111
I have another sheet with every QLD suburb in it in alphabetical order in a named range called rSuburbs
i.e.
Ashgrove
BBBB
CCC
Sandgate
Zilmere
What formula can I write to find the closest match and dump it out, i.e. like this:
COLUMN A COLUMN B
My Company 123 Big Street Ashgrove QLD 4111 Ashgrove
A Better Compant PO Box 123 Sandgate QLD 4111 Sandgate
Try this formula in B2 copied down
=LOOKUP(2^15,SEARCH(" "&rSuburbs&" "," "&A2&" "),rSuburbs)
Using " "& ensures that you don't get partial matches
Assuming your list of suburbs is in column K2:6 with the heading suburbs in K1:
{=INDEX(K:K,LARGE(IFERROR(FIND($K$2:$K$6,A2)*0+ROW(A$2:A$6),0),1))}
Array formulas must be confirmed with ctrl+shift+enter -- do not try to enter the squiggly braces manually!
This will return the desired output.
Basically, figure out if each of the list is in the text in column A, return the row number of the suburb if it is, or zero if it isn't, and take the suburb of the largest index you get.
If you are interested in a vba solution this will print the suburb name in Column B, amend to match your workbook.
Option Explicit
Sub splitlr()
Dim wb As Workbook
Dim ws As Worksheet
Dim s As String, str As String
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim lr As Long
Dim a As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
With ws
a = 1
Do Until a = lr
s = .Range("A" & a).Text
i = Len(s)
j = InStrRev(s, " ") - 1
k = InStrRev(s, " ", j) - 1
l = InStrRev(s, " ", k)
str = Mid(s, l, (i - k))
.Range("B" & a).Value = str
a = a + 1
Loop
End With
End Sub