[ATTACH=CONFIG]51703[/ATTACH]
I am not very experienced into vba maybe somebody can help me.
This is a example of raw data that I have.
Done until now:
Find duplicate from column C (except word FMS), and copy of this on other F column and count them on G column.
To do : For each mach add from column B the cell value "header" number (01301....) into separated column H, I, J, J ......
example: 016-FL1055 3 , 130160020001, 0130160060002 on each column
The code that find the mach is bellow:
Code
Sub TestCount()
Dim rngCell As Range
Dim arrWords() As String, arrCounts() As Integer, arrNest() As String
Dim bExists As Boolean
Dim i As Integer, j As Integer, k As Integer
Dim LastRow As Long
Dim nst_number As String
With Worksheets("--- ^Search^ ---")
LastRow = .Cells(rows.Count, "D").End(xlUp).Row
End With
ReDim arrWords(0)
ReDim arrNest(0)
For Each rngCell In ThisWorkbook.Sheets("--- ^Search^ ---").Range("D2:D" & LastRow)
bExists = False
If rngCell = "FMS" Then
nst_number = ""
nst_number = rngCell.Offset(0, -1).value
End If
If rngCell <> "" And rngCell <> "FMS" Then
For i = 0 To UBound(arrWords)
If arrWords(i) = rngCell.value Then
bExists = True
arrCounts(i) = arrCounts(i) + 1
End If
Next i
If bExists = False Then
ReDim Preserve arrWords(j)
ReDim Preserve arrCounts(j)
arrWords(j) = rngCell.value
arrCounts(j) = 1
j = j + 1
End If
End If
Next
For i = LBound(arrWords) To UBound(arrWords)
MsgBox arrWords(i) & ", " & arrCounts(i)
With Worksheets("--- ^Search^ ---")
.Cells(i + 2, 7).value = arrWords(i)
.Cells(i + 2, 8).value = arrCounts(i)
End With
Next i
End sub
Display More