Help with modifing code??

[Mekinnik]

I found this code that Tom Ogilvy created for searching for duplicates and I
was wondering if it is possible to modify the code the search for duplicates
based off of what the user selects in a combobox? I know that this code not
only searches but also copies, I was just going to leave out the copy part?

Sub FindDuplicates()
Dim colNum as String
Dim rng as range, cell as Range
Dim rng1 as Range
colNum = "A"
With Activesheet
set rng = .Range(.Cells(1,colNum), _
.Cells(rows.count,colNum).End(xlup))
End With
for each cell in rng
if application.Countif(rng,cell) > 1 then
if rng1 is nothing then
set rng1 = cell
else
set rng1 = Union(rng1,cell)
end if
end if
Next
If not rng1 is nothing then
rng1.entireRow.Copy Sheets(2).Range("A1")
End if
End Sub

 

[Chip Pearson]

You do you mean by "based off of what the user selects in a combobox"? Do
you mean find multiple instances of a value in a combobox?

If you combobox is on Sheet1 and named ComboBox1, you can call the following
code from the combobox's Change event:

Sub SelectDups()
Dim RR As Range
Dim R As Range
Dim V As Variant
Dim Dups As Range
With Worksheets("Sheet1")
Set RR = .Range(.Range("A1"), .Cells(.Rows.Count, "A").End(xlUp))
End With
V = Sheet1.ComboBox1.Value
If V = vbNullString Then
Exit Sub
End If
For Each R In RR
If StrComp(V, R.Text, vbTextCompare) = 0 Then
If Dups Is Nothing Then
Set Dups = R
Else
Set Dups = Application.Union(Dups, R)
End If
End If
Next R
If Not Dups Is Nothing Then
Dups.Select
End If
End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Mekinnik]

Mr. Pearson,
My database stores manufacturer names and their products, so 1 manufacturer
can have many products but a product can only have 1 manufacturer). So the
first combobox is the manufacturer name and the second is the product name. I
want the first combobox to populate the second based off of what the first
finds in it search, so lets say I type in "Citgo" I want the combobox change
event to search the manufacturer database to find that name and then populate
combobox 2 with the products that are produced by "Citgo". In addition if it
does not find the name I want it to show my manufacturer entry userform. I
have found similar stuff on Contexturers web site but all those use functions
within the sheet and I am trying to do this with VBA. I hope this explains
what I am trying to accomplish.

 

[Chip Pearson]

If you have your manufacturers in column A and products in column B, such as

Mfg1 Prod1A
Mfg1 Prod1B
Mfg1 Prod1C
Mfg2 Prod2A
Mfg2 Prod2B
Mfg3 <blank>

The following code in you userform's code module will sync the
manufacturer's combobox cbxMfg with the product combobox cbxProd. If there
is no product for a manufacture (as in Mfg3 in the example above), a message
box is displayed.


Option Explicit
Option Compare Text

Private bEnableEvents As Boolean
Private MfgRange As Range
Private ProdRange As Range

Private Sub cbxMfg_Change()

Dim R As Range
Dim MfgName As String

If bEnableEvents = False Then
Exit Sub
End If

With Me.cbxMfg
If .ListIndex >= 0 Then
MfgName = .List(.ListIndex)
End If
End With

With Me.cbxProd
bEnableEvents = False
.Clear
For Each R In MfgRange
If R.Text = MfgName Then
If R(1, 2).Text <> vbNullString Then
.AddItem R(1, 2).Text
End If
End If
Next R

If .ListCount > 0 Then
.ListIndex = 0
End If

bEnableEvents = True

If .ListCount = 0 Then
MsgBox "No products match manufacturer: " & MfgName & ". Do
something."
End If
End With

End Sub

Private Sub UserForm_Initialize()

Dim MfgName As String
Dim Coll As Collection
Dim R As Range
Dim N As Long

Set Coll = New Collection
Set MfgRange = Worksheets("Sheet1").Range("A2:A10") '<<< CHANGE AS REQUIRED
Set ProdRange = Worksheets("Sheet2").Range("B2:B10") '<<< CHANGE AS REQUIRED

On Error Resume Next
For Each R In MfgRange
Coll.Add Item:=R, key:=R
Next R

bEnableEvents = False
With Me.cbxMfg
.Clear
For N = 1 To Coll.Count
.AddItem Coll(N)
Next N
If .ListCount > 0 Then
.ListIndex = 0
MfgName = .List(0)
For Each R In MfgRange
If R.Text = MfgName Then
Me.cbxProd.AddItem R(1, 2).Text
End If
Next R
If Me.cbxProd.ListCount > 0 Then
Me.cbxProd.ListIndex = 0
End If
End If
End With
bEnableEvents = True

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Mekinnik]

Mr. Pearson,
I inserted your code into my database, however I ended up with a run-time
error '1004' because I am desinging this as I go and I currently do not have
any of the columns filled yet. When I do try and test it I end up with a
conflict because on my enter manufacturer userform I have enabled the user to
delete manufacturer names and when that happens the run time error goes off.
I need assistance in merging the two delete buttons into the macro, I have on
the manufacter userform and 1 on the product entery userform, however they
just delete the row matching whats in the name boxes, I would guess I would
have to find a way for it to delete the whole tree (manufacturer name and all
products/or just a product but not the manufacturer name if it has more than
one product). If it would help I would be willing to send you my .xls file
for you review if it would help.