VBA code to separate & count matching items in a list

[zakynthos]

Hi,

Assuming I have an open-ended no, of names sorted into groups in Column A (starting A1)
What would be the VBA to:
Search and cut all names after group 1 (say, A1:A30),
Paste this new list - group 2 (say A31:500) into Column B (start B1)
Search and cut all names after Group 2 (say B50:B500)
Paste this new list into Column C (start C1) etc etc.
Repeat process into and paste to Cols D, E, F etc etc
Finally search the first blank cell in Cols A: etc
Provide a count of the number of items in each column

Thanks for your help.

 

[texasalynn]

so how is the grouping determined? is there a pattern to be found?

 

[zakynthos]

The grouping is determined by locality. The count would be for each unit in a locality, and this would be the no. of occurrences of the name of the locality.

For example, say 'Area A" started in A1 and there were 30 'Area A' s in cells A2:A30. A31:A61 say, 30 'Area B', Area C 40 in A62:A102 etc etc. So VBA returns 30 A's, 30 B's and 40 C's.

The program would need to look down column A find where 'Area B' started, cut and move all 'Area B's to Column B, then find all 'Area C's and move them to Column C. Finally, counting the no. of occurrences of Areas A, B, C in each column.

In practice the names would be variable and could be those of ANY area in the UK, areas of London (eg London Borough of Wansdworth etc) or an area of say Scotland, say Glasgow. In other words, the VBA would need to identify identical groups of areas (where the names are open-ended, not literally a finite group like Area A, Area B and Area C) and in contiguous rows, select them, move each area to a separate column and count total occurrences of that area.

I hope this makes it a bit clearer.

Thanks

 

[texasalynn]

ok I'll get back to you tomorrow

 

[texasalynn]

see if this is what you need

be sure to make a copy of your sheet before you try this code

Sub breakout_group()
Dim LR As Long, LC As Long, x As Long
Dim Rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim ws As String
Dim AreaArray, fn As WorksheetFunction
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
LC = ActiveSheet.Range("IV1").End(xlToLeft).Column + 1
ws = ActiveSheet.Name
Set fn = Application.WorksheetFunction
With Sheets(ws)
    Set Rng = .UsedRange
    .Range("A:A").AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=.Cells(1, LC + 2), Unique:=True
    Set Rng2 = Intersect(.Columns(LC + 2).CurrentRegion, _
            .Rows("1:" & Rows.Count))
    ReDim AreaArray(1 To Rng2.Cells.Count)
    AreaArray = fn.Transpose(Rng2)
    .Columns(LC + 2).Clear
For x = LBound(AreaArray) To UBound(AreaArray)
    If x <> 1 Then
        Rng.AutoFilter Field:=1, Criteria1:=AreaArray(x)
        Set Rng3 = Intersect(Rng, .Cells.SpecialCells(xlCellTypeVisible))
        Rng3.Copy Destination:=Cells(1, LC)
        Rng3.Clear
        Rng.AutoFilter
        LC = ActiveSheet.Range("IV2").End(xlToLeft).Column + 1
    End If
Next x
Rng.AutoFilter
End With
Rows("1:1").EntireRow.Insert
Cells(1, 2).NumberFormat = "General"
Cells(1, 2).Formula = "=countA(" & Range(Cells(2, "B"), Cells(LR, "B")).Address(False, False) & ")"
Cells(1, 2).Copy Destination:=Range(Cells(1, "B"), Cells(1, LC - 1))
    Application.Calculate
    
MsgBox "Done"
End Sub

 

[zakynthos]

Thanks for your reply. I copied your code on data in Column A (about 6000 rows of grouped areas) but found on running it:

- only the first 5 rows were displayed in column A with a filer on
- none of the other groups were copied to columns B, C,D E etc and
- no count of no. per group.

Is something missing?

Thanks

 

[texasalynn]

ok then I will need you to post a small sample of your data

 

[zakynthos]

Thanks again for your help.

Example of Data in Column A: (starting at A1)

London Borough of Bromley
London Borough of Bromley
London Borough of Bromley
London Borough of Bromley
London Borough of Bromley
London Borough of Bromley
London Borough of Wandsworth
London Borough of Wandsworth
London Borough of Wandsworth
London Borough of Wandsworth
London Borough of Wandsworth
Glasgow
Glasgow
Glasgow
Glasgow
Glasgow

At any one time there might be as many as 50000 rows of similar data, so these are large files I'm working on.

With these variable numbers of localities, I need to get a quick count of how many of each.

I hope this makes it a little clearer.

Thanks again for your help.

 

[texasalynn]

ok so before the macro the data looks like

Excel Workbook
	A
1	London Borough of Bromley
2	London Borough of Bromley
3	London Borough of Bromley
4	London Borough of Bromley
5	London Borough of Bromley
6	London Borough of Bromley
7	London Borough of Wandsworth
8	London Borough of Wandsworth
9	London Borough of Wandsworth
10	London Borough of Wandsworth
11	London Borough of Wandsworth
12	Glasgow
13	Glasgow
14	Glasgow
15	Glasgow
16	Glasgow
17
Sheet1

Excel 2003

and after it looks like

Excel Workbook
	B	C	D
1	6	5	5
2	London Borough of Bromley
3	London Borough of Bromley	London Borough of Wandsworth	Glasgow
4	London Borough of Bromley	London Borough of Wandsworth	Glasgow
5	London Borough of Bromley	London Borough of Wandsworth	Glasgow
6	London Borough of Bromley	London Borough of Wandsworth	Glasgow
7	London Borough of Bromley	London Borough of Wandsworth	Glasgow
Sheet1

Excel 2003

Cell Formulas
Range	Formula
B1	=COUNTA(B2:B16)
C1	=COUNTA(C2:C16)
D1	=COUNTA(D2:D16)

 

[texasalynn]

so I'm looking again at your post with the data, you don't want the data moved but just a total count? If that is the case then a pivot table will work

Excel Workbook
	A	B
3	Count of Area
4	Area	Total
5	Glasgow	5
6	London Borough of Bromley	6
7	London Borough of Wandsworth	5
8	Grand Total	16
Sheet4

Excel 2003