Starting from specific place in a row

[FunnyUser]

I have a code that counts duplicates in selected range and writes them down in specific column. It looks like that:

Sub CountDuplicates()
    Dim ws As Worksheet
    Dim lastRow As Long, x As Long
    Dim items As Object
        Application.ScreenUpdating = False
    Set ws = Arkusz1
        lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    Set items = CreateObject("Scripting.Dictionary")
    For x = 1 To lastRow
    If Not items.exists(ws.Range("A" & x).Value) Then
        items.Add ws.Range("A" & x).Value, 1
        ws.Range("AM" & x).Value = items(ws.Range("A" & x).Value)
    Else
        items(ws.Range("A" & x).Value) = items(ws.Range("A" & x).Value) + 1
        ws.Range("AM" & x).Value = items(ws.Range("A" & x).Value)
    End If
    Next x
End Sub

I use this to operate on files which look like that:

ID;English [en];Finnish (FINLAND) [fi_FI];Polish [pl]
Source[global].UnitGroup[Length].ID[115];millimeter;;
Source[global].UnitGroup[Length].ID[116];mm;;
Source[global].UnitGroup[Length].ID[117];centimeter;;
Source[global].UnitGroup[Length].ID[118];cm;;
Source[global].UnitGroup[Length].ID[119];meter;;
Source[global].UnitGroup[Length].ID[120];m;;
Source[global].UnitGroup[Length].ID[176];inch;;
Source[global].UnitGroup[Length].ID[177];inch;;
Source[global].UnitGroup[Length].ID[186];nanometer;;
Source[global].UnitGroup[Length].ID[187];nm;;
Source[global].UnitGroup[Length].ID[188];micrometer;;
Source[global].UnitGroup[Length].ID[189];µm;;
Source[global].UnitGroup[Length].ID[7579];;;
Source[global].UnitGroup[Length].ID[7580];;;
Source[global].UnitGroup[Length].ID[86777];feet;;

The problem is that it will not find any duplicates. I want this program to start looking for duplicates for example after first ";" in every row. In this case rows with the ID 7579 and 7580 would be duplicates. Thanks for help and sorry for my terrible english ..

[mana]

Msagbox Split(ws.Range("A" & x).Value, ";")(1)

[Artik]

I understand that ID = 176 and 177 will also be duplicates.
If so, then this way:

Sub CountDuplicates_1()
    Dim ws          As Worksheet
    Dim lastRow As Long, x As Long
    Dim items       As Object
    Dim strVal      As String
    Dim lPos As Long
    
    Application.ScreenUpdating = False
    
    Set ws = Arkusz1
    lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    Set items = CreateObject("Scripting.Dictionary")
    
    For x = 1 To lastRow
        
        strVal = ws.Cells(x, "A").Value
        lPos = InStr(1, strVal, ";", vbBinaryCompare)
        'rest of the text string after the first character ";"
        strVal = Mid(strVal, lPos + 1)
        
        If Not items.exists(strVal) Then
            items.Add strVal, 1
            ws.Cells(x, "AM").Value = items(strVal)
        Else
            items(strVal) = items(strVal) + 1
            ws.Cells(x, "AM").Value = items(strVal)
        End If
    Next x
    
End Sub

Artik

[snb]

In B1:

=COUNTIF(A$1:A$100;"*"&MID(A1;FIND(";";A1);LEN(A1)))