Identifying mixed Managers

[pcarmour]

Hi,
I have a macro that sorts and groups a spreadsheet by Post Code. I am now trying ti identify any group that has mixed managers, I am doing this by a formula in column J which at the moment only works on most groups not all. you can see on the attached down to row 19 is working but the group in rows 20-22 needs X in J20 and J21 it then is OK down to row 49 with the group in rows 50-53 not working. I then want to delete the groups without the X. I just cant seem to get it right.

Any help as always is very much appreciated.

I am working with Windows Home Premium version 6.1.7601 SP 1 Build 7601and Excel version 14.0.6123.5001 (32 bit)
11896

[p45cal]

in J2:
=IF(SUMPRODUCT(($C$2:$C$4169=$C2)*($I$2:$I$4169<>$I2))>0,"X","")
copy down.
The rows do not need to be in any particular order.

Autofilter the whole shooting match and filter on column J for blanks, select what you see and delete.

[GTO]

Greetings Peter,

If you only wanted to list each manager once (per post code), I was thinking using dictionaries might work.

In a Standard Module:


Option Explicit

Sub example()
Dim DIC As Object ' Scripting.Dictionary
Dim SubDIC As Object ' Scripting.Dictionary
Dim rngFound As Range
Dim rngPostCodes As Range
Dim arrPostCodes As Variant
Dim tmp As Variant
Dim Keys As Variant
Dim Items As Variant
Dim SubItems As Variant
Dim Output() As Variant
Dim n As Long
Dim j As Long
Dim i As Long

Set DIC = CreateObject("Scripting.Dictionary")

Set rngFound = RangeFound(Sheet1.Range("C:C"))

If rngFound Is Nothing Then Exit Sub
If rngFound.Row < 3 Then Exit Sub

arrPostCodes = Sheet1.Range(Sheet1.Cells(2, "C"), rngFound).Offset(, -2).Resize(, 9).Value

For n = 1 To UBound(arrPostCodes)

If DIC.Exists(arrPostCodes(n, 3)) Then

If Not DIC.Item(arrPostCodes(n, 3)).Exists(arrPostCodes(n, 9)) Then

Set SubDIC = DIC.Item(arrPostCodes(n, 3))

ReDim tmp(1 To 9)
For j = 1 To 9
tmp(j) = arrPostCodes(n, j)
Next

SubDIC.Add arrPostCodes(n, 9), tmp
Set DIC.Item(arrPostCodes(n, 3)) = SubDIC
End If

Else

Set SubDIC = CreateObject("Scripting.Dictionary")

ReDim tmp(1 To 9)
For j = 1 To 9
tmp(j) = arrPostCodes(n, j)
Next

SubDIC.Add arrPostCodes(n, 9), tmp
DIC.Add arrPostCodes(n, 3), SubDIC
End If

Next

Keys = DIC.Keys
Items = DIC.Items

For n = 0 To UBound(Keys)
If Not DIC.Item(Keys(n)).Count > 1 Then
DIC.Remove Keys(n)
End If
Next

Keys = DIC.Keys
Items = DIC.Items

ReDim Output(1 To 9, 1 To 1)

Set SubDIC = Items(0)
SubItems = SubDIC.Items

For j = 1 To 9
Output(j, 1) = SubItems(0)(j)
Next

For n = LBound(SubItems) + 1 To UBound(SubItems)
ReDim Preserve Output(1 To 9, 1 To UBound(Output, 2) + 1)
For j = 1 To 9
Output(j, UBound(Output, 2)) = SubItems(n)(j)
Next
Next

For i = 1 To UBound(Items)

Set SubDIC = Items(i)
SubItems = SubDIC.Items
For n = LBound(SubItems) To UBound(SubItems)
ReDim Preserve Output(1 To 9, 1 To UBound(Output, 2) + 1)
For j = 1 To 9
Output(j, UBound(Output, 2)) = SubItems(n)(j)
Next
Next
Next

ThisWorkbook.Worksheets.Add(Type:=xlWorksheet).Range("A2").Resize(UBound(Output, 2), 9).Value _
= Application.Transpose(Output)

End Sub

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Hope that helps,

Mark

[pcarmour]

Hi P45cal & Mark,
Firstly thank you both for your prompt and expert replies.

Working with your code P45cal it does exactly as I required but I do want to keep the order and just now delete the X's.
Running Mark's code does remove the required rows but further sorting is then required to get back to the view needed.

These solutions enable me to continue with my project, Thank you both.