Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default 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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 7,247
Default 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


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default 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


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 7,247
Default 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



  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default 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



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
NEED HELP MODIFING A CELL miguel_0319 Excel Discussion (Misc queries) 1 August 2nd 09 05:55 PM
modifing the find function Chris Excel Discussion (Misc queries) 1 March 18th 08 07:00 PM
Modifing a userform txtbox code [email protected] Excel Programming 0 June 13th 07 03:41 PM
Modifing a recorded macro. Duane Reynolds Excel Programming 1 August 9th 06 05:27 AM
Modifing data to show up better in chart. Mike Punko Charts and Charting in Excel 5 August 23rd 05 12:44 AM


All times are GMT +1. The time now is 11:13 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"