Hi
Another option,
In Worksheet (Report) module. Right click on tab 'Report' > view code > paste the code there.
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
kTest
End Sub
in a standard module
Code:
Option Explicit
Sub kTest()
Dim d, k, w, x, i As Long, n As Long, Country As String
Dim c As String, s As String, m As String
Set d = CreateObject("scripting.dictionary")
w = Worksheets("Extract ESR").Range("a1").CurrentRegion.Resize(, 11).Value2
Country = Worksheets("Report").Range("c1")
ReDim k(1 To UBound(w, 1), 1 To 1)
For i = 2 To UBound(w, 1)
c = Country & w(i, 4) & w(i, 11)
If c = w(i, 1) Then
If Not d.exists(c) Then
If InStr(1, m, w(i, 6)) = 0 Then
n = n + 1
k(n, 1) = w(i, 6)
m = m & "," & w(i, 6)
End If
d.Item(c) = w(i, 6)
Else
If InStr(1, m, w(i, 6)) = 0 Then
n = n + 1
k(n, 1) = w(i, 6)
m = m & "," & w(i, 6)
End If
End If
End If
Next
If n Then
With Worksheets("Extract ESR").Range("w2").Resize(UBound(w, 1))
.ClearContents
If Not .NumberFormat = "@" Then .NumberFormat = "@"
.Value = k
End With
End If
End Sub
Now while you change the country, the ids will be updated automatically. You don't need those formulas in columns R,S,T,U and V.
Bookmarks