E
Eric
Hello all,
I am trying to do a remove duplicates based on two seperate criterias. The
first criteria is contract number and the second is mix type. All the
information is on the same page Contract number is in column A and mix type
is in Column B. I am using the remove duplicate macro to determine which
contact I need. Then that contract number (and associated information) is
pasted onto a seperate sheet, this works great, but now I want to enhance
this by removeing all but one mix type for that contract.. Is this possible?
Here is the macro that I am using for the no duplicates of contract numbers.
Sub RemoveDuplicates()
Dim allcells As Range, cell As Range
Dim nodupes As New Collection
On Error Resume Next
For Each cell In Range("A27:A500")
nodupes.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0
For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item
UserForm1.Show
End Sub
************************************
Private Sub ListBox1_Click()
Range("D6").Value = ListBox1
For i = 0 To UserForm1.ListBox1.ListCount - 1
If UserForm1.ListBox1.Selected(i) Then
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set ws = Sheets("Test Database")
Set rng = ws.Range("a26:AC500")
ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("D6").Value
ws.AutoFilter.Range.Copy
Sheets("test database2").Select
Range("C500").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, -2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next
End Sub
Contract number mix type Pb Vtm
#200
1234 1 5.0 4.0
3.2
1234 5 5.0 3.5
2.5
1234 1 4.8 2.5
4.6
456 6 5.0 2.0
1.0
I want to have pasted onto a seperate sheet the following information:
Contract number mix type Pb Vtm
#200
1234 1 5.0 4.0
3.2
1234 1 4.8 2.5
4.6
I thank you in advance for everyones help. Thank you
Eric
I am trying to do a remove duplicates based on two seperate criterias. The
first criteria is contract number and the second is mix type. All the
information is on the same page Contract number is in column A and mix type
is in Column B. I am using the remove duplicate macro to determine which
contact I need. Then that contract number (and associated information) is
pasted onto a seperate sheet, this works great, but now I want to enhance
this by removeing all but one mix type for that contract.. Is this possible?
Here is the macro that I am using for the no duplicates of contract numbers.
Sub RemoveDuplicates()
Dim allcells As Range, cell As Range
Dim nodupes As New Collection
On Error Resume Next
For Each cell In Range("A27:A500")
nodupes.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0
For Each item In nodupes
UserForm1.ListBox1.AddItem item
Next item
UserForm1.Show
End Sub
************************************
Private Sub ListBox1_Click()
Range("D6").Value = ListBox1
For i = 0 To UserForm1.ListBox1.ListCount - 1
If UserForm1.ListBox1.Selected(i) Then
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set ws = Sheets("Test Database")
Set rng = ws.Range("a26:AC500")
ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("D6").Value
ws.AutoFilter.Range.Copy
Sheets("test database2").Select
Range("C500").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, -2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next
End Sub
Contract number mix type Pb Vtm
#200
1234 1 5.0 4.0
3.2
1234 5 5.0 3.5
2.5
1234 1 4.8 2.5
4.6
456 6 5.0 2.0
1.0
I want to have pasted onto a seperate sheet the following information:
Contract number mix type Pb Vtm
#200
1234 1 5.0 4.0
3.2
1234 1 4.8 2.5
4.6
I thank you in advance for everyones help. Thank you
Eric