Create range of only duplicates from another range

[dpm]

[I'm using Excel 2003]

I have a Range1 of non-contiguous cells. I would like to do one of two things:

1. Remove all cells from Range1 whose values are not duplicated

or...

2. Create a Range2 containing only cells whose values are duplicated in Range1

Is this possible?

I see tons of examples for dealing with duplicates in sheets, lists, tables...everything but ranges. I've been searching for days and it's very frustrating.

I'm working in the VBE. I'm an Access VBA developer and don't know the Excel object model very well. And I can do only the most basic things with formulas, in the UI. Trust me!

Thanks in advance for any help.

[mdmackillop]

Welcome to VBAX
You'll need to define your range and set the Offset for Option 1

[VBA]
Sub dups()
Dim Rng As Range, cel As Range
Set Rng = Cells(1, 1).CurrentRegion
For Each cel In Rng
If Application.CountIf(Rng, cel) > 1 Then
'Option 1
cel.Offset(, 13) = cel
'or Option 2
Sheets(2).Range(cel.Address).Value = cel
End If
Next

End Sub

[/VBA]

[dpm]

Hello, and thanks very much for the welcome and for the prompt reply.

I have a range defined, in code. It contains a group of cells from two columns where a particular value exists in yet a third column. I couldn't for the life of me figure out how to do that in the UI, so I did it in the VBE.

Besides, once I figure this out, I've got to build a loop which does the same thing for every unique value in that 'third column'.

With that said, I did study your code. I've seen similar procedures and have tried a few. I always get an error when the CountIf function is called.

Usually it's a generic looking thing that says something like, "unable to apply CountIf". In this case, I get a type mismatch (when I pass my range into your sub and set rng equal to the passed-in range).

I figure it's because my range contains non-continguous cells.

[mdmackillop]

Can you post yopur workbook? Use Manage Attachments in the Go Advanced reply section.

[dpm]

Attached. Thank you very much for taking a look. I put a note in Sheet1 describing what I'm trying to accomplish.

[mdmackillop]

Do you want to highlight dates duplicated in either column eg B2, B13, or only those in B which also appear in C

[mdmackillop]

[VBA]
Option Explicit
Public Sub Start()
Dim rngTeam As Range
Dim cel As Range
Dim rngDates As Range
Dim i As Long
Dim varRetVal As Variant
Set rngTeam = CreateTeamRange
Set rngDates = rngTeam.Offset(, 1).Resize(, 2)
If rngTeam Is Nothing Then
MsgBox "There is no data in Column A"
Exit Sub
End If
Call HighlightDuplicates(rngDates)
For Each cel In rngTeam
For i = 1 To 2
If cel = 1 Then
If cel.Offset(, i).Interior.ColorIndex = 6 Then
cel.Offset(, i + 2) = cel.Offset(, i)
cel.Offset(, i + 2).NumberFormat = "dd-mmm"
End If
End If
Next i
Next

End Sub
Public Function CreateTeamRange() As Range
Dim rng As Range
On Error GoTo ErrHandler
Dim varRetVal As Variant
Set rng = Worksheets("Sheet1").Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Set CreateTeamRange = rng
ExitHandler:
'Set rng = Nothing
Exit Function
ErrHandler:
MsgBox "VBA Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & "In: Sheet1", vbCritical
Resume ExitHandler
Resume
End Function

Private Sub HighlightDuplicates(Values As Range)
Dim cell
For Each cell In Values
If Application.CountIf(Values, cell.Value) > 1 Then
cell.Interior.ColorIndex = 6
End If
Next cell
End Sub
[/VBA]

[dpm]

All dates duplicated in both columns B and C, for each value in column A

[dpm]

Yes, the values your procedure places now in columns D and E represent the cells in B and C that I wish to highlight.

I'm studying your loop now to see if I can adapt it to do the highlighting that I need, instead of copying the values to another column.

I don't know what the original spreadsheet looks like. The gentleman I'm helping sent me the sample structure in the attached file.

Edit:
Sorry, I should clarify.

Here is the intended result in in other words:

For any cell in A which equals "1",
Find all cells in both B and C which are duplicated,
and highlight those cells.

I must eventually loop for all other values in A as well.

[mdmackillop]

The code uses the highlight color to identify duplicates corresponding to 1. Happy to assist further if you can confirm required outputs.

[dpm]

When I run it, I get the results shown in the attached .jpg.

All cells in the date columns are highlighted, regardless what is in A.

I'll post a picture showing the intended result in another post.

Thanks very much for looking.

[dpm]

I'm trying to achieve this:

[dpm]

My apologies, I left out one cell which is duplicated.

Here are the intended results (corrected).

Thank you.

[mikerickson]

How about putting this Condiditional Formatting formula on B2 and copying the format to the other cells.
=SUMPRODUCT(--($A$2:$A$24&$B$2:$B$24=$A2&B2)+($A$2:$A$24&$C$2:$C$24=$A2&B2))>1

In addition to the team 1 cells above, it also highlights the team 3 cells B13, C13, C14, C15, C17, C18, B19 & C19
Also team 7's B23:C24

[dpm]

mikerickson, this is brilliant. I knew there must be a way to do this in the interface. It's great. It applies the format on entry of new data also, which is another desired result.

However, the user of this document stated that there are around 300 teams. The sample I have has just a handful of teams for testing.

I feel I'm going to have to accomplish this programmatically...to loop through each Team and highlight the duplicated cells which are associated with each of the 300 teams.

I don't know what these teams are, but the user said "a team can't be in two places on the same day". So I suppose they are a group of people who travel.

Edit:

Hmm...I'm no formula expert but, upon closer inspection, it appears this would work for any value in column A. I'm testing now.

[dpm]

Ok, I see that it will in fact work for any value in A.

Is there a way to maintain this conditional format for B and C when rows are added beyond 24? Is it possible to apply conditional formatting to a dynamic range?

[dpm]

Now that I've looked more closely, I see that it's highlighting duplicates across teams. This is not desired.

Also, I am able to enter duplicated dates for which highlighting will not occur. Perhaps I'm applying this formula incorrectly.

Regardless, I see the power of formulas...not that I can manage them. I have great respect for you who successfully work in and behind Excel. Access VBA is much easier, for me.

[mdmackillop]

You are correct, Countif will not work with non-contiguous ranges

Dynamic version using Range Names with Offset function.

[mikerickson]

You could use Dynamic ranges
Name: TeamsCol
RefersTo: = OFFSET(Sheet1$A$2,0,0,COUNTA(Sheet1!$A:$A),1)

Name: Date1Col
RefersTo: =OFFSET(TeamsCol,0,1)

Name: Date2Col
RefersTo: =OFFSET(TeamsCol,0,2)

Then the CF formula (entered in B2) would become

=SUMPRODUCT(--(TeamsCol&Date1Col=$A2&B2)+(TeamsCol&Date2Col= $A2&B2))>1

[dpm]

mdmackillop,

I gave this a good test. Also brilliant. The only hitch I noticed is that the behavior is a little quirky if I skip any rows. I doubt the office using this sheet skips rows, however. I just thought I'd see what would happen if I did.

Question, please. It appears the only code behind necessary here is Sub hh in Module1. Can you verify?

I'm quite impressed with both of you, and I've been coding Access applications for 16 years. Excel certainly is a different animal.

Oh, one other question: When I send this to the gentleman I am assisting, where exactly do I tell him to apply conditional formatting in his real worksheet? Do I create the conditional format while the headers of B and C are selected?

Thanks so much for the help.

I won't be taking any credit for this, by the way. I'll let the user know that a fellow denizen of the UK produced it (I don't know which country he's from, but he's got an accent which is decidedly not Texan). I've already told him I'm seeking help on forums, as it is. D

mikerickson,

mdmckillop's solution has formulae nearly identical to those you've offered. Since I'd have to hound you both to death getting it all arranged, were I to reinvent that wheel, I'll just go with his completed solution.
Thanks very much for help as well.