PDA

View Full Version : Starting from specific place in a row



FunnyUser
08-11-2019, 11:24 PM
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
08-12-2019, 12:03 AM
Msagbox Split(ws.Range("A" & x).Value, ";")(1)

Artik
08-12-2019, 02:55 AM
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
08-12-2019, 03:12 AM
In B1:


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