Input box pour ameliorer macro dedoublonnage

.......Pour éviter cela j'aimerai pouvoir créer une input box qui me
permettrait de modifier les 6 critères.

Ca c'est impossible !
Une soluce de remplacement : Autant d'inputBx qu'il y a de variables :
Exemple (je te laisse un peu de boulot pour peaufiner les imputboxes et autres
msgbox à destination de l'utilisateur)

Sub RemoveDuplicatesInList()
-------------
'Edit the next 6 lines to reflect the actual setup

lgDéb = InputBox("ligne déb", "")
If lgDéb = "" Or lgDéb > 65535 Then Exit Sub

lgFin = InputBox("ligne fin", "")
If lgFin = "" Or lgFin > 65536 Or lgFin < lgDéb Then Exit Sub

On Error Resume Next
Set x = Application.InputBox("Sélection colonnes", "ColumnsToMatch", , , , , ,
8)
Set CheckRows = Rows(lgDéb & ":" & lgFin)
ColumnsToMatch = Array(x.Address(0, 0))

leteDuplicates = InputBox("False ou True", "leteDuplicates", "False")
If leteDuplicates <> False And leteDuplicates <> True Then Exit Sub

Pour les variables "FormatDuplicates", "WriteListOfDuplicates" et
"AddRowNumberToList", je te les laisse faire sur le même modèle que
"leteDuplicates"

Il y aurait une autre solution qui consisterait à créer une UserForm à la volée
en positionnant les contrôles...etc....
Ben là je passe la main car il y a un peu trop de boulot !

AV

Salut Alain,
J'étais justement en train de regarder ce truc que je trouve vraiment
bien. Pour sélectionner à plage à dédoublonner, j'essayais d'utiliser un
refedit alternatif (macro de Michel Pierron ci dessous) permettant d'un
seul coup de renseigner les 4 premières inputbox. Mais je coince un peu
pour récupérer à partir du range la première et la dernière ligne, la
première et la dernière colonne. Je viens de poster une question à ce
sujet...

Function RngInput(Optional Prompt As String, Optional Defaut As Range)
As Range 'Michel Pierron MPFE
Const Title As String = "Saisie utilisateur"

If Prompt = "" Then Prompt = "Veuillez sélectionner une ou plusieurs
cellules !"
With Application
If Defaut Is Nothing Then
If ActiveCell Is Nothing Then
Set RngInput = .InputBox(Prompt, Title, , , , , , 8)
Else
Set RngInput = .InputBox(Prompt, Title, ActiveCell.Address, , ,
, , 8)
End If
Else
On Error Resume Next
Set RngInput = .InputBox(Prompt, Title, Defaut.Address, , , , , 8)
End If
End With
End Function

Sub IdemRefEdit()
Dim Rng As Range

Set Rng = RngInput(, Range("B3"))
If Rng Is Nothing Then MsgBox "Opération annulée !", 64, "Info
utilisateur": Exit Sub

'*Exemple:
If MsgBox("Effacer la sélection " _
& Rng.Address, 4 + 32 + 0, "Info utilisateur ") = vbYes Then Rng.Delete
Set Rng = Nothing
End Sub


Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta



AV wrote:

.......Pour éviter cela j'aimerai pouvoir créer une input box qui me
permettrait de modifier les 6 critères.

Ca c'est impossible !
Une soluce de remplacement : Autant d'inputBx qu'il y a de variables :
Exemple (je te laisse un peu de boulot pour peaufiner les imputboxes et autres
msgbox à destination de l'utilisateur)

Sub RemoveDuplicatesInList()
-------------
'Edit the next 6 lines to reflect the actual setup

lgDéb = InputBox("ligne déb", "")
If lgDéb = "" Or lgDéb > 65535 Then Exit Sub

lgFin = InputBox("ligne fin", "")
If lgFin = "" Or lgFin > 65536 Or lgFin < lgDéb Then Exit Sub

On Error Resume Next
Set x = Application.InputBox("Sélection colonnes", "ColumnsToMatch", , , , , ,
8)
Set CheckRows = Rows(lgDéb & ":" & lgFin)
ColumnsToMatch = Array(x.Address(0, 0))

leteDuplicates = InputBox("False ou True", "leteDuplicates", "False")
If leteDuplicates <> False And leteDuplicates <> True Then Exit Sub

Pour les variables "FormatDuplicates", "WriteListOfDuplicates" et
"AddRowNumberToList", je te les laisse faire sur le même modèle que
"leteDuplicates"

Il y aurait une autre solution qui consisterait à créer une UserForm à la volée
en positionnant les contrôles...etc....
Ben là je passe la main car il y a un peu trop de boulot !

AV

--

Alain:

Merci c'est exactement ce que je recherchais. J' en profite pour poser une
questions subsidiaire:
1- l'auteur indique que la recherche de doublons s'effectuer sur plusieurs
colonnes mais que c'est le OU INCLUSIF qui est utilisé. Est-il possible
d'avoir à la place le ET? Par exemple n'est considéré doublons que si le
contenu respectifs des colonnes A et B sont identiques ou encore mieux sur
une selection du type $A:$A,$C:$D

Remerciements.

Christophe
----------------------------------------------------------------------------
--------

Sub RemoveDuplicatesInList()
'leo.heuser@adslhome.dk, August 24, 2001/21-1-2002, Version 1.1.
'Cette procédure détruit ou met en évidence les doublons dans une liste.
'La destruction/mise en évidence procède par lignes entières.
'Une liste des doublons peut être constituée dans une nouvelle feuille,
'insérée après la feuille active. Les numéros des lignes concernées
'peuvent être ajoutées à la liste.
'La recherche de doublons peut s'effectuer sur plusieurs colonnes.
'Par exemple, la colonne A peut contenir plusieurs fois "Peter" et la
'colonne B plusieurs fois "Smith".
'Si le paramètre ColumnsToWatch est fixé à Array("A","B"), tous les doublons
'qui sont trouvés dans "A" OU "B" seront détruits/mis en évidence.
'C'est le OU inclusif qui est utilisé : A OU B OU LES DEUX
' A B
'1 Nom Prénom
'2 Peter Smith
'3 Ian Smith
'4 Dana Jones
'5 Peter Neal
'6 Peter Smith
'Avec ces contraintes, les lignes 3, 5 et 6 sont considérées
'comme des doublons. La ligne 6 n'apparaîtra qu'une seule fois
'dans le résultat final.

Dim CheckRows As Range
Dim ColumnsToMatch As Variant
Dim DeleteDuplicates As Boolean
Dim FormatDuplicates As Boolean
Dim WriteListOfDuplicates As Boolean
Dim AddRowNumberToList As Boolean
Dim lLBound As Long
Dim lUBound As Long
Dim CheckRange As Range
Dim SubArray As Variant
Dim FieldCollection() As New Collection
Dim RowNumberCollection As New Collection
Dim Dummy As Long
Dim DuplicateRange As Range
Dim DuplicatesExist As Boolean
Dim lRow As Long
Dim OffsetValue() As Long
Dim StartCell As Range
Dim Element As Variant
Dim Counter As Long

'Edit the next 6 lines to reflect the actual setup
'Set CheckRows = Rows("1:5000")
'ColumnsToMatch = Array("A:B")
'DeleteDuplicates = True
'FormatDuplicates = False
'WriteListOfDuplicates = True
'AddRowNumberToList = False


'les ligne suivantes définissant les input box ont été écrites par AV sur
MPFE
lgDéb = InputBox("Input first row number e.g. 2", "")
If lgDéb = "" Or lgDéb > 65535 Then Exit Sub

lgFin = InputBox("Input last row numberl", "")
If lgFin = "" Or lgFin > 65536 Or lgFin < lgDéb Then Exit Sub

On Error Resume Next
Set x = Application.InputBox("Select column or range of columns e.g. $A:$A",
"ColumnsToMatch", , , , , , 8)
Set CheckRows = Rows(lgDéb & ":" & lgFin)
ColumnsToMatch = Array(x.Address(0, 0))

DeleteDuplicates = InputBox("False ou True", "DeleteDuplicates", "True")
If DeleteDuplicates <> False And DeleteDuplicates <> True Then Exit Sub

FormatDuplicates = InputBox("False ou True", "FormatDuplicates", "False")
If FormatDuplicates <> False And FormatDuplicates <> True Then Exit Sub

WriteListOfDuplicates = InputBox("False ou True", "WriteListOfDuplicates",
"True")
If WriteListOfDuplicates <> False And WriteListOfDuplicates <> True Then
Exit Sub

AddRowNumberToList = InputBox("False ou True", "AddRowNumberToList",
"False")
If AddRowNumberToList <> False And AddRowNumberToList <> True Then Exit Sub
' fin lignes input box

lLBound = LBound(ColumnsToMatch)
lUBound = UBound(ColumnsToMatch)

Set CheckRange = Intersect(Range(ColumnsToMatch(lLBound) & _
":" & ColumnsToMatch(lLBound)), CheckRows)

ReDim OffsetValue(lUBound - lLBound + 1)
ReDim FieldCollection(lUBound - lLBound + 1)

For Counter = lLBound To lUBound
OffsetValue(Counter) = Range(ColumnsToMatch(Counter) & ":" & _
ColumnsToMatch(Counter)).Column - CheckRange.Column
Next Counter

On Error Resume Next
SubArray = CheckRange.Value
For lRow = 1 To UBound(SubArray, 1)
If SubArray(lRow, 1) <> "" Then
For Counter = lLBound To lUBound
FieldCollection(Counter).Add _
Dummy, CStr(CheckRange(lRow, 1).Offset(0, _
OffsetValue(Counter)).Value)
If Err.Number = 457 Then
Err.Clear
DuplicatesExist = True
RowNumberCollection.Add _
CheckRange(lRow, 1).Row, _
CStr(CheckRange(lRow, 1).Row)
If Err.Number = 0 Then
If DuplicateRange Is Nothing Then
Set DuplicateRange = _
CheckRange.Cells(lRow, 1)
Else
Set DuplicateRange = Union(DuplicateRange, _
CheckRange.Cells(lRow, 1))
End If
Else
Err.Clear
End If
End If
Next Counter
End If
Next lRow
On Error GoTo 0

If DuplicatesExist = False Then
MsgBox "No duplicates exist.", vbInformation
Else
With DuplicateRange.EntireRow
If WriteListOfDuplicates Then
Worksheets.Add After:=DuplicateRange.Parent
.Copy Destination:=Range("A1")
If AddRowNumberToList Then
Columns("A").Insert
Set StartCell = Range("A1")
For Each Element In RowNumberCollection
StartCell.Value = "Row " & Element
Set StartCell = StartCell.Offset(1, 0)
Next Element
End If
End If
If FormatDuplicates Then .Font.ColorIndex = 3
If DeleteDuplicates Then .Delete
End With
End If

End Sub





"AV" <alain.vallon@wanadoo.fr> a écrit dans le message de
news:boi26q$f87$1@news-reader3.wanadoo.fr...

.......Pour éviter cela j'aimerai pouvoir créer une input box qui me
permettrait de modifier les 6 critères.

Ca c'est impossible !
Une soluce de remplacement : Autant d'inputBx qu'il y a de variables :
Exemple (je te laisse un peu de boulot pour peaufiner les imputboxes et
autres

msgbox à destination de l'utilisateur)

Sub RemoveDuplicatesInList()
-------------
'Edit the next 6 lines to reflect the actual setup

lgDéb = InputBox("ligne déb", "")
If lgDéb = "" Or lgDéb > 65535 Then Exit Sub

lgFin = InputBox("ligne fin", "")
If lgFin = "" Or lgFin > 65536 Or lgFin < lgDéb Then Exit Sub

On Error Resume Next
Set x = Application.InputBox("Sélection colonnes", "ColumnsToMatch", , , ,
, ,

8)
Set CheckRows = Rows(lgDéb & ":" & lgFin)
ColumnsToMatch = Array(x.Address(0, 0))

leteDuplicates = InputBox("False ou True", "leteDuplicates", "False")
If leteDuplicates <> False And leteDuplicates <> True Then Exit Sub

Pour les variables "FormatDuplicates", "WriteListOfDuplicates" et
"AddRowNumberToList", je te les laisse faire sur le même modèle que
"leteDuplicates"

Il y aurait une autre solution qui consisterait à créer une UserForm à la
volée

en positionnant les contrôles...etc....
Ben là je passe la main car il y a un peu trop de boulot !

AV

Bonjour,

Léo Heuser a réalisé plusieurs versions de sa macro de recherches de doublons.
Il y en a 3 sur mon site. Celle qui pourrait correspondre à ta demande est à
cette adresse :

http://perso.wanadoo.fr/frederic.sigonneau/code/Tris/ElimineDoublons4.txt

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Alain:

Merci c'est exactement ce que je recherchais. J' en profite pour poser une
questions subsidiaire:
1- l'auteur indique que la recherche de doublons s'effectuer sur plusieurs
colonnes mais que c'est le OU INCLUSIF qui est utilisé. Est-il possible
d'avoir à la place le ET? Par exemple n'est considéré doublons que si le
contenu respectifs des colonnes A et B sont identiques ou encore mieux sur
une selection du type $A:$A,$C:$D

Remerciements.

Christophe
----------------------------------------------------------------------------
--------

Sub RemoveDuplicatesInList()
'leo.heuser@adslhome.dk, August 24, 2001/21-1-2002, Version 1.1.
'Cette procédure détruit ou met en évidence les doublons dans une liste.
'La destruction/mise en évidence procède par lignes entières.
'Une liste des doublons peut être constituée dans une nouvelle feuille,
'insérée après la feuille active. Les numéros des lignes concernées
'peuvent être ajoutées à la liste.
'La recherche de doublons peut s'effectuer sur plusieurs colonnes.
'Par exemple, la colonne A peut contenir plusieurs fois "Peter" et la
'colonne B plusieurs fois "Smith".
'Si le paramètre ColumnsToWatch est fixé à Array("A","B"), tous les doublons
'qui sont trouvés dans "A" OU "B" seront détruits/mis en évidence.
'C'est le OU inclusif qui est utilisé : A OU B OU LES DEUX
' A B
'1 Nom Prénom
'2 Peter Smith
'3 Ian Smith
'4 Dana Jones
'5 Peter Neal
'6 Peter Smith
'Avec ces contraintes, les lignes 3, 5 et 6 sont considérées
'comme des doublons. La ligne 6 n'apparaîtra qu'une seule fois
'dans le résultat final.

Dim CheckRows As Range
Dim ColumnsToMatch As Variant
Dim DeleteDuplicates As Boolean
Dim FormatDuplicates As Boolean
Dim WriteListOfDuplicates As Boolean
Dim AddRowNumberToList As Boolean
Dim lLBound As Long
Dim lUBound As Long
Dim CheckRange As Range
Dim SubArray As Variant
Dim FieldCollection() As New Collection
Dim RowNumberCollection As New Collection
Dim Dummy As Long
Dim DuplicateRange As Range
Dim DuplicatesExist As Boolean
Dim lRow As Long
Dim OffsetValue() As Long
Dim StartCell As Range
Dim Element As Variant
Dim Counter As Long

'Edit the next 6 lines to reflect the actual setup
'Set CheckRows = Rows("1:5000")
'ColumnsToMatch = Array("A:B")
'DeleteDuplicates = True
'FormatDuplicates = False
'WriteListOfDuplicates = True
'AddRowNumberToList = False

'les ligne suivantes définissant les input box ont été écrites par AV sur
MPFE
lgDéb = InputBox("Input first row number e.g. 2", "")
If lgDéb = "" Or lgDéb > 65535 Then Exit Sub

lgFin = InputBox("Input last row numberl", "")
If lgFin = "" Or lgFin > 65536 Or lgFin < lgDéb Then Exit Sub

On Error Resume Next
Set x = Application.InputBox("Select column or range of columns e.g. $A:$A",
"ColumnsToMatch", , , , , , 8)
Set CheckRows = Rows(lgDéb & ":" & lgFin)
ColumnsToMatch = Array(x.Address(0, 0))

DeleteDuplicates = InputBox("False ou True", "DeleteDuplicates", "True")
If DeleteDuplicates <> False And DeleteDuplicates <> True Then Exit Sub

FormatDuplicates = InputBox("False ou True", "FormatDuplicates", "False")
If FormatDuplicates <> False And FormatDuplicates <> True Then Exit Sub

WriteListOfDuplicates = InputBox("False ou True", "WriteListOfDuplicates",
"True")
If WriteListOfDuplicates <> False And WriteListOfDuplicates <> True Then
Exit Sub

AddRowNumberToList = InputBox("False ou True", "AddRowNumberToList",
"False")
If AddRowNumberToList <> False And AddRowNumberToList <> True Then Exit Sub
' fin lignes input box

lLBound = LBound(ColumnsToMatch)
lUBound = UBound(ColumnsToMatch)

Set CheckRange = Intersect(Range(ColumnsToMatch(lLBound) & _
":" & ColumnsToMatch(lLBound)), CheckRows)

ReDim OffsetValue(lUBound - lLBound + 1)
ReDim FieldCollection(lUBound - lLBound + 1)

For Counter = lLBound To lUBound
OffsetValue(Counter) = Range(ColumnsToMatch(Counter) & ":" & _
ColumnsToMatch(Counter)).Column - CheckRange.Column
Next Counter

On Error Resume Next
SubArray = CheckRange.Value
For lRow = 1 To UBound(SubArray, 1)
If SubArray(lRow, 1) <> "" Then
For Counter = lLBound To lUBound
FieldCollection(Counter).Add _
Dummy, CStr(CheckRange(lRow, 1).Offset(0, _
OffsetValue(Counter)).Value)
If Err.Number = 457 Then
Err.Clear
DuplicatesExist = True
RowNumberCollection.Add _
CheckRange(lRow, 1).Row, _
CStr(CheckRange(lRow, 1).Row)
If Err.Number = 0 Then
If DuplicateRange Is Nothing Then
Set DuplicateRange = _
CheckRange.Cells(lRow, 1)
Else
Set DuplicateRange = Union(DuplicateRange, _
CheckRange.Cells(lRow, 1))
End If
Else
Err.Clear
End If
End If
Next Counter
End If
Next lRow
On Error GoTo 0

If DuplicatesExist = False Then
MsgBox "No duplicates exist.", vbInformation
Else
With DuplicateRange.EntireRow
If WriteListOfDuplicates Then
Worksheets.Add After:=DuplicateRange.Parent
.Copy Destination:=Range("A1")
If AddRowNumberToList Then
Columns("A").Insert
Set StartCell = Range("A1")
For Each Element In RowNumberCollection
StartCell.Value = "Row " & Element
Set StartCell = StartCell.Offset(1, 0)
Next Element
End If
End If
If FormatDuplicates Then .Font.ColorIndex = 3
If DeleteDuplicates Then .Delete
End With
End If

End Sub

"AV" <alain.vallon@wanadoo.fr> a écrit dans le message de
news:boi26q$f87$1@news-reader3.wanadoo.fr...

.......Pour éviter cela j'aimerai pouvoir créer une input box qui me
permettrait de modifier les 6 critères.

Ca c'est impossible !
Une soluce de remplacement : Autant d'inputBx qu'il y a de variables :
Exemple (je te laisse un peu de boulot pour peaufiner les imputboxes et
autres

msgbox à destination de l'utilisateur)

Sub RemoveDuplicatesInList()
-------------
'Edit the next 6 lines to reflect the actual setup

lgDéb = InputBox("ligne déb", "")
If lgDéb = "" Or lgDéb > 65535 Then Exit Sub

lgFin = InputBox("ligne fin", "")
If lgFin = "" Or lgFin > 65536 Or lgFin < lgDéb Then Exit Sub

On Error Resume Next
Set x = Application.InputBox("Sélection colonnes", "ColumnsToMatch", , , ,
, ,

8)
Set CheckRows = Rows(lgDéb & ":" & lgFin)
ColumnsToMatch = Array(x.Address(0, 0))

leteDuplicates = InputBox("False ou True", "leteDuplicates", "False")
If leteDuplicates <> False And leteDuplicates <> True Then Exit Sub

Pour les variables "FormatDuplicates", "WriteListOfDuplicates" et
"AddRowNumberToList", je te les laisse faire sur le même modèle que
"leteDuplicates"

Il y aurait une autre solution qui consisterait à créer une UserForm à la
volée

en positionnant les contrôles...etc....
Ben là je passe la main car il y a un peu trop de boulot !

AV

Frédéric:

C'est exatement ce que je recherchais.

Merci mille fois.

Christophe
"Frédéric Sigonneau" <frederic.sigonneau@wanadoo.fr> a écrit dans le message
de news:3FAE4652.4EC9E93D@wanadoo.fr...

Bonjour,

Léo Heuser a réalisé plusieurs versions de sa macro de recherches de
doublons.

Il y en a 3 sur mon site. Celle qui pourrait correspondre à ta demande est
à

cette adresse :

http://perso.wanadoo.fr/frederic.sigonneau/code/Tris/ElimineDoublons4.txt

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Alain:

Merci c'est exactement ce que je recherchais. J' en profite pour poser
une

questions subsidiaire:
1- l'auteur indique que la recherche de doublons s'effectuer sur
plusieurs

colonnes mais que c'est le OU INCLUSIF qui est utilisé. Est-il possible
d'avoir à la place le ET? Par exemple n'est considéré doublons que si le
contenu respectifs des colonnes A et B sont identiques ou encore mieux
sur

une selection du type $A:$A,$C:$D

Remerciements.

Christophe

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

--------

Sub RemoveDuplicatesInList()
'leo.heuser@adslhome.dk, August 24, 2001/21-1-2002, Version 1.1.
'Cette procédure détruit ou met en évidence les doublons dans une liste.
'La destruction/mise en évidence procède par lignes entières.
'Une liste des doublons peut être constituée dans une nouvelle feuille,
'insérée après la feuille active. Les numéros des lignes concernées
'peuvent être ajoutées à la liste.
'La recherche de doublons peut s'effectuer sur plusieurs colonnes.
'Par exemple, la colonne A peut contenir plusieurs fois "Peter" et la
'colonne B plusieurs fois "Smith".
'Si le paramètre ColumnsToWatch est fixé à Array("A","B"), tous les
doublons

'qui sont trouvés dans "A" OU "B" seront détruits/mis en évidence.
'C'est le OU inclusif qui est utilisé : A OU B OU LES DEUX
' A B
'1 Nom Prénom
'2 Peter Smith
'3 Ian Smith
'4 Dana Jones
'5 Peter Neal
'6 Peter Smith
'Avec ces contraintes, les lignes 3, 5 et 6 sont considérées
'comme des doublons. La ligne 6 n'apparaîtra qu'une seule fois
'dans le résultat final.

Dim CheckRows As Range
Dim ColumnsToMatch As Variant
Dim DeleteDuplicates As Boolean
Dim FormatDuplicates As Boolean
Dim WriteListOfDuplicates As Boolean
Dim AddRowNumberToList As Boolean
Dim lLBound As Long
Dim lUBound As Long
Dim CheckRange As Range
Dim SubArray As Variant
Dim FieldCollection() As New Collection
Dim RowNumberCollection As New Collection
Dim Dummy As Long
Dim DuplicateRange As Range
Dim DuplicatesExist As Boolean
Dim lRow As Long
Dim OffsetValue() As Long
Dim StartCell As Range
Dim Element As Variant
Dim Counter As Long

'Edit the next 6 lines to reflect the actual setup
'Set CheckRows = Rows("1:5000")
'ColumnsToMatch = Array("A:B")
'DeleteDuplicates = True
'FormatDuplicates = False
'WriteListOfDuplicates = True
'AddRowNumberToList = False

'les ligne suivantes définissant les input box ont été écrites par AV
sur

MPFE
lgDéb = InputBox("Input first row number e.g. 2", "")
If lgDéb = "" Or lgDéb > 65535 Then Exit Sub

lgFin = InputBox("Input last row numberl", "")
If lgFin = "" Or lgFin > 65536 Or lgFin < lgDéb Then Exit Sub

On Error Resume Next
Set x = Application.InputBox("Select column or range of columns e.g.
$A:$A",

"ColumnsToMatch", , , , , , 8)
Set CheckRows = Rows(lgDéb & ":" & lgFin)
ColumnsToMatch = Array(x.Address(0, 0))

DeleteDuplicates = InputBox("False ou True", "DeleteDuplicates", "True")
If DeleteDuplicates <> False And DeleteDuplicates <> True Then Exit Sub

FormatDuplicates = InputBox("False ou True", "FormatDuplicates",
"False")

If FormatDuplicates <> False And FormatDuplicates <> True Then Exit Sub

WriteListOfDuplicates = InputBox("False ou True",
"WriteListOfDuplicates",

"True")
If WriteListOfDuplicates <> False And WriteListOfDuplicates <> True Then
Exit Sub

AddRowNumberToList = InputBox("False ou True", "AddRowNumberToList",
"False")
If AddRowNumberToList <> False And AddRowNumberToList <> True Then Exit
Sub

' fin lignes input box

lLBound = LBound(ColumnsToMatch)
lUBound = UBound(ColumnsToMatch)

Set CheckRange = Intersect(Range(ColumnsToMatch(lLBound) & _
":" & ColumnsToMatch(lLBound)), CheckRows)

ReDim OffsetValue(lUBound - lLBound + 1)
ReDim FieldCollection(lUBound - lLBound + 1)

For Counter = lLBound To lUBound
OffsetValue(Counter) = Range(ColumnsToMatch(Counter) & ":" & _
ColumnsToMatch(Counter)).Column - CheckRange.Column
Next Counter

On Error Resume Next
SubArray = CheckRange.Value
For lRow = 1 To UBound(SubArray, 1)
If SubArray(lRow, 1) <> "" Then
For Counter = lLBound To lUBound
FieldCollection(Counter).Add _
Dummy, CStr(CheckRange(lRow, 1).Offset(0, _
OffsetValue(Counter)).Value)
If Err.Number = 457 Then
Err.Clear
DuplicatesExist = True
RowNumberCollection.Add _
CheckRange(lRow, 1).Row, _
CStr(CheckRange(lRow, 1).Row)
If Err.Number = 0 Then
If DuplicateRange Is Nothing Then
Set DuplicateRange = _
CheckRange.Cells(lRow, 1)
Else
Set DuplicateRange = Union(DuplicateRange, _
CheckRange.Cells(lRow, 1))
End If
Else
Err.Clear
End If
End If
Next Counter
End If
Next lRow
On Error GoTo 0

If DuplicatesExist = False Then
MsgBox "No duplicates exist.", vbInformation
Else
With DuplicateRange.EntireRow
If WriteListOfDuplicates Then
Worksheets.Add After:=DuplicateRange.Parent
.Copy Destination:=Range("A1")
If AddRowNumberToList Then
Columns("A").Insert
Set StartCell = Range("A1")
For Each Element In RowNumberCollection
StartCell.Value = "Row " & Element
Set StartCell = StartCell.Offset(1, 0)
Next Element
End If
End If
If FormatDuplicates Then .Font.ColorIndex = 3
If DeleteDuplicates Then .Delete
End With
End If

End Sub

"AV" <alain.vallon@wanadoo.fr> a écrit dans le message de
news:boi26q$f87$1@news-reader3.wanadoo.fr...

.......Pour éviter cela j'aimerai pouvoir créer une input box qui me
permettrait de modifier les 6 critères.

Ca c'est impossible !
Une soluce de remplacement : Autant d'inputBx qu'il y a de variables :
Exemple (je te laisse un peu de boulot pour peaufiner les imputboxes
et

autres

msgbox à destination de l'utilisateur)

Sub RemoveDuplicatesInList()
-------------
'Edit the next 6 lines to reflect the actual setup

lgDéb = InputBox("ligne déb", "")
If lgDéb = "" Or lgDéb > 65535 Then Exit Sub

lgFin = InputBox("ligne fin", "")
If lgFin = "" Or lgFin > 65536 Or lgFin < lgDéb Then Exit Sub

On Error Resume Next
Set x = Application.InputBox("Sélection colonnes", "ColumnsToMatch", ,
, ,

, ,

8)
Set CheckRows = Rows(lgDéb & ":" & lgFin)
ColumnsToMatch = Array(x.Address(0, 0))

leteDuplicates = InputBox("False ou True", "leteDuplicates", "False")
If leteDuplicates <> False And leteDuplicates <> True Then Exit Sub

Pour les variables "FormatDuplicates", "WriteListOfDuplicates" et
"AddRowNumberToList", je te les laisse faire sur le même modèle que
"leteDuplicates"

Il y aurait une autre solution qui consisterait à créer une UserForm à
la

volée

en positionnant les contrôles...etc....
Ben là je passe la main car il y a un peu trop de boulot !

AV