Hi Johan,

Am Thu, 30 May 2019 03:22:31 -0700 (PDT) schrieb JS SL:

So you get;
A1= MisterX - MisterY - MisterZ
A2= AA.BB.CC 60
A3= DD.EE.FF 100
A4= GG.HH.II 20

you can also try following macro and check out which of the macros works
better for your layout and your problem:

Sub SumCodes2()
Dim LCol As Integer, i As Integer, n As Integer, x As Integer, z As
Integer
Dim LRowSh1 As Long, LRowSh2 As Long, j As Long
Dim varNames As Variant, varCodes As Variant, varTmp As Variant
Dim codeSum As Long
Dim rngC As Range
Dim sCode As String, iNmbr As Integer

With Sheets("Sheet2")
LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LRowSh2 = .Cells(.Rows.Count, "G").End(xlUp).Row
varNames = .Range("H1", .Cells(1, LCol))
varCodes = .Range("G2:G" & LRowSh2)
End With

Application.ScreenUpdating = False

With Sheets("Sheet1")
For i = LBound(varNames, 2) To UBound(varNames, 2)
z = i + 10
LRowSh1 = .Cells(.Rows.Count, z).End(xlUp).Row
For j = LBound(varCodes) To UBound(varCodes)
x = j + 1
codeSum = 0
For Each rngC In .Range(.Cells(6, z), .Cells(LRowSh1, z)).SpecialCells(xlCellTypeConstants)
If InStr(rngC, Chr(10)) = 0 Then
sCode = Left(Split(rngC, "[")(0), Len(Split(rngC, "[")(0)) - 1)
iNmbr = Left(Split(rngC, "[")(1), Len(Split(rngC, "[")(1)) - 1)
If Application.CountIf(Sheets("Sheet2").Range("G:G"), sCode) = 0 Then
rngC.Interior.Color = vbRed
ElseIf sCode Like varCodes(j, 1) & "*" Then
codeSum = codeSum + iNmbr
End If
Else
varTmp = Split(rngC, Chr(10))
For n = LBound(varTmp) To UBound(varTmp)
sCode = Left(Split(varTmp(n), "[")(0), Len(Split(varTmp(n), "[")(0)) - 1)
iNmbr = Left(Split(varTmp(n), "[")(1), Len(Split(varTmp(n), "[")(1)) - 1)
If
Application.CountIf(Sheets("Sheet2").Range("G:G"), sCode) = 0 Then
rngC.Interior.Color = vbRed
ElseIf sCode Like varCodes(j, 1) & "*" Then
codeSum = codeSum + iNmbr
End If
Next
End If
Next
If codeSum 0 Then Sheets("Sheet2").Cells(x, z - 3) = codeSum
Next
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Windows10
Office 2016