Søg om det samme navn står 2 gange i et ark/kolone?

Hvis navnet står i kolonne D og firmaet i kolonne E kan det gøres med disse 2 formler:
=COUNTIF(D:D;B1)
=COUNTIF(E:E;B1)
Alternativt kan du lave betinget formattering i cellerne B1 og B2 med disse formler:
=COUNTIF(D:D;B1)>1

Hvis navnene står i kolonne B og firmaet i kolonne C:

Sub Test()
Sheets("Ark1").Select
Dim MitArray, I As Long, Y As Long, NytArray, D As Long, Navn As String, Antal As Long
ReDim NytArray(0)
Slut = Range("A65536").End(xlUp).Row
MitArray = Range("B1:C" & Slut)

For I = 1 To UBound(MitArray) - 1
    Navn = ""
    For Y = I + 1 To UBound(MitArray)
        If (MitArray(I, 1) = MitArray(Y, 1)) And (MitArray(I, 2) = MitArray(Y, 2)) And MitArray(I, 1) <> "" Then
            If Antal = 0 Then
                Navn = "Navn: " & MitArray(I, 1) & " | celle " & I & " - "
            End If
            Antal = Antal + 1
            Navn = Navn & "celle " & Y & " - "
            MitArray(Y, 1) = ""
        End If
    Next
        If Navn <> "" Then
            D = D + 1
            ReDim Preserve NytArray(D)
            NytArray(D) = Navn
        End If
        Antal = 0
Next
Sheets("Ark2").Select
For Z = 1 To UBound(NytArray)
    Range("A" & Z) = NytArray(Z)
Next
End Sub

Tak for de fine svar.

Jeg kan ikke få koden til at virke. den går bare over til næste side. Mine navne står i kolone B og firma i kolone C. eks:
jan    vvs
peter    ups
Martin1    VVs1
martin2    vvs2
Martin3    VVs3
Martin4    VVs4
Martin5    VVs5
Martin6    VVs6
Martin7    VVs7
Martin8 VVs8
jan    vvs
Martin14 VVs14

Hertil skulle jeg gerne enten på næste ark få en navnet. Ellers skal jeg have en markering af en art.

Endvidere skal den medtage et nummer som står vedsiden af firmaret (tilbudsnummer).

Er det muligt?

Undskylder lige mit dårlige dansk og prøver igen.

I den forgående tabel vil jeg ikke have "Jan" fra firmaet "vvs" til at stå 2 gange. Derfor skal makroen/formlen gøre mig opmærksom på at han figurerer 2 gange. Dette skal den gøre på et andet ark.

Tak

Det var lidt nemmere hvis vi vidste hvilket Ark du ville have kopier
Så denne markerer evt. kopier røde (Aktiver aktuel Ark)

Sub FindDubletter()
Dim c, r, t, t2
c = 2 ' Kolonne B
r = Cells(65500, c).End(xlUp).Row
For t = 1 To r
If Cells(t, c) <> "" Then
For t2 = t + 1 To r
If Cells(t, c) = Cells(t2, c) And Cells(t, c + 1) = Cells(t2, c + 1) Then
Cells(t2, c).Interior.ColorIndex = 3: Cells(t2, c + 1).Interior.ColorIndex = 3
End If
Next
End If
Next
End Sub

Koden 05/09-2007 09:03:39 gør lige netop det du vil.

Den skriver Navn: jan| celle 1 - celle 11 -

Hvis du ikke har noget til at atå i kolonne 1 skal koden være:

Sub Test()
Sheets("Ark1").Select
Dim MitArray, I As Long, Y As Long, NytArray, D As Long, Navn As String, Antal As Long
ReDim NytArray(0)
Slut = Range("B65536").End(xlUp).Row
MitArray = Range("B1:C" & Slut)

For I = 1 To UBound(MitArray) - 1
    Navn = ""
    For Y = I + 1 To UBound(MitArray)
        If (MitArray(I, 1) = MitArray(Y, 1)) And (MitArray(I, 2) = MitArray(Y, 2)) And MitArray(I, 1) <> "" Then
            If Antal = 0 Then
                Navn = "Navn: " & MitArray(I, 1) & " | celle " & I & " - "
            End If
            Antal = Antal + 1
            Navn = Navn & "celle " & Y & " - "
            MitArray(Y, 1) = ""
        End If
    Next
        If Navn <> "" Then
            D = D + 1
            ReDim Preserve NytArray(D)
            NytArray(D) = Navn
        End If
        Antal = 0
Next
Sheets("Ark2").Select
For Z = 1 To UBound(NytArray)
    Range("A" & Z) = NytArray(Z)
Next
End Sub

Respons...

???