Opsplitning af kolonne til en matrix

Koden indsættes i Data-arket:

Dim antalRæk, mRæk1, mrækX
Sub produktMatrix()
    antalRæk = findAntalRækker
    mRæk1 = antalRæk + 2
    mrækX = mRæk1 + 1
   
    findProdukter
End Sub
Private Function findAntalRækker()
    findAntalRækker = Cells(Rows.Count, 1) _
      .End(xlUp).Offset(1, 0).Row - 1
End Function
Private Sub findProdukter()
Dim produkt
    Cells(mRæk1, 1) = "Land"
   
    For ræk = 1 To antalRæk
        Cells(mrækX, 1) = Cells(ræk, 1)
        For kol = 2 To 240
            produkt = Cells(ræk, kol)
            If produkt = "" Then
                mrækX = mrækX + 1
                Exit For
            End If
           
            findesProdukt produkt, ræk
        Next kol
    Next ræk

End Sub
Private Sub findesProdukt(produkt, ræk)
    For kol = 2 To 240
        If Cells(mRæk1, kol) = produkt Then
            Cells(mrækX, kol) = "X"
            Exit Sub
        Else
            If Cells(mRæk1, kol) = "" Then
                Cells(mRæk1, kol) = produkt
                Cells(mrækX, kol) = "X"
                Exit Sub
            End If
        End If
    Next kol
End Sub

http://pmexcelent.dk/Matrix.xls

Hej supertekst og excelent

Supertekst, den funger ikke lige som jeg ønskede.

excelent, funger glimrende og nemt. Med dine demo data funger det uden problemer, dog når jeg har mange rækker (over 100) med mine egne data, kommer der kolonne overskrift, men der kommer ingen krydser. 

Ellers kan du ikke sende et ”svar”, sådan at jeg kan tildele dig dine point?

Og tak til Jer begge for indsatsen.

ok velbekom
Har lige testet med ca 200 rækker,- virker ok her
Får du nogen fejlmedd. eller lign ?

Nej jeg får ingen fejlmeddelelse, heller ikke når jeg dublerer dine data til over 1000 rækker. Så et gæt er er, at der er noget i dataene der forårsager fejlen.

Jeg har prøvet at opdele reellife dataene i mindre grupper, hvor de kører lige igennem. Til det jeg skal bruge opdelingen til, er det glimrende. Så tak endnu en gang.