Help with modifing code??
 

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

Help with modifing code??
 

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" wrote in message
...
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

Help with modifing code??
 

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" wrote:

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" wrote in message
...
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

Help with modifing code??
 

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" wrote in message
...
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" wrote:

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" wrote in message
...
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

Help with modifing code??
 

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.

"Chip Pearson" wrote:

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" wrote in message
...
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" wrote:

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" wrote in message
...
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