PDA

View Full Version : Create range of only duplicates from another range



dpm
03-22-2009, 06:44 AM
[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
03-22-2009, 06:52 AM
Welcome to VBAX
You'll need to define your range and set the Offset for Option 1


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

dpm
03-22-2009, 07:12 AM
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
03-22-2009, 07:14 AM
Can you post yopur workbook? Use Manage Attachments in the Go Advanced reply section.

dpm
03-22-2009, 07:36 AM
Attached. Thank you very much for taking a look. I put a note in Sheet1 describing what I'm trying to accomplish.

mdmackillop
03-22-2009, 07:52 AM
Do you want to highlight dates duplicated in either column eg B2, B13, or only those in B which also appear in C

mdmackillop
03-22-2009, 08:11 AM
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

dpm
03-22-2009, 08:15 AM
All dates duplicated in both columns B and C, for each value in column A

dpm
03-22-2009, 08:23 AM
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
03-22-2009, 08:32 AM
The code uses the highlight color to identify duplicates corresponding to 1. Happy to assist further if you can confirm required outputs.

dpm
03-22-2009, 08:58 AM
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
03-22-2009, 08:59 AM
I'm trying to achieve this:

dpm
03-22-2009, 09:02 AM
My apologies, I left out one cell which is duplicated.

Here are the intended results (corrected).

Thank you.

mikerickson
03-22-2009, 09:33 AM
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
03-22-2009, 09:58 AM
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
03-22-2009, 10:11 AM
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
03-22-2009, 10:50 AM
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
03-22-2009, 10:51 AM
You are correct, Countif will not work with non-contiguous ranges

Dynamic version using Range Names with Offset function.

mikerickson
03-22-2009, 11:15 AM
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
03-22-2009, 11:27 AM
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.

mdmackillop
03-22-2009, 11:35 AM
Sorry, that weas just some debug code. Mike's solution which I adjusted needs no code to run.
The Range Names need to be set according to the data locations. Once this is done, the CF formula is entered in the first cell with the A, B, C references adjusted to to suit, then copied to other cells using the Format Painter.

dpm
03-22-2009, 11:52 AM
Interestingly, when I delete Module1, formatting ceases to be applied to new rows. I closed and re-opened the document and it's as if the dynamic range is not resizing, if you will.

I then deleted about half the rows and began entering data again. The formatting is being applied.

------------------------------

Ahh, I see what's happening - it has nothing to do with Module1. It's just that from Row 37 on, the conditional format is gone.

dpm
03-22-2009, 11:59 AM
Thank you. I understand that I'll need to have him create 3 named ranges, editing them if necessary, depending upon which columns he's using in the real sheet.

Then create a CF on the first cell of his Team column (again tailoring them if necessary).

Then copied (painted) to all cells in the Team column?

Sorry to seem like such a novice using Excel. Unfortunately, however, I am. :)

I've interoperated via Access for years, but have never had to create projects *in* Excel.

Edit:

Pardon me, to all cells in the Date Columns? (not Team)

dpm
03-22-2009, 12:06 PM
Never mind about the format painter. I see that I can paint the entire columns with the format. Cheers.