Try this....
Option Explicit
Sub InsertJointFamilyCode()
Dim Rng As Range, Cell As Range, Rng1 As Range, Cell1 As Range, vRng As Range, vCell As Range
Dim lr As Long, i As Long
Dim ID As String, jID As String
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Range("C2:C" & lr)
ActiveSheet.AutoFilterMode = 0
If lr > 1 Then Range("G2:G" & lr).Value = ""
i = 1
For Each Cell In Rng
If Cell <> ID And Cells(Cell.Row, "G") = "" Then
ID = Cell
With Rows(1)
.AutoFilter field:=3, Criteria1:=ID
If Range("C1:C" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
Set vRng = Range("B2:B" & lr).SpecialCells(xlCellTypeVisible)
For Each vCell In vRng
jID = jID & "," & vCell
Next vCell
Set Rng1 = Range(Cells(Cell.Row, "B"), Cells(lr, "B"))
For Each Cell1 In Rng1
If Cells(Cell1.Row, "G") = "" And InStr(jID, Cell1.Value) > 0 Then
Cells(Cell1.Row, "G") = i
End If
Next Cell1
i = i + 1
End If
End With
End If
Next Cell
ActiveSheet.AutoFilterMode = 0
Application.ScreenUpdating = True
End Sub
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks