I have been doing this manually where I have four (1 column) lists with some overlapping values and want to assign an attribute to every UNIQUE value depending on whether or not it exists in one of the lists. The code runs and is pretty accurate for first run, but I can't see what I'm missing to make 100% accurate. One problem is, it is leaving out the very first value it tests and doesn't add it when i know it should. Second, it is leaving out about 30 out of the 800 unique values all together. Anyone have a clue!?

Sub PhaseSet()

Dim eAr As Variant
Dim hAr As Variant
Dim fAr As Variant
Dim nAr As Variant

Dim eC As Range
Dim hC As Range
Dim fC As Range
Dim nC As Range
Dim rCell As Range

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim eh As Single
Dim LastRow As Integer

Set ws = ThisWorkbook.Sheets("Sheet5")
Set eC = ws.Range("D3:D717")
Set hC = ws.Range("I3:I346")
Set fC = ws.Range("N3:N113")
Set nC = ws.Range("S3:S28")

eAr = eC.Value
hAr = hC.Value
fAr = fC.Value
nAr = nC.Value

Set ws1 = ThisWorkbook.Sheets.Add

For i = 1 To UBound(eAr)
    eh = 0
    
    For j = 1 To UBound(hAr)
        If eAr(i, 1) = hAr(j, 1) Then
            eh = eh + 0.1
        End If
    Next j
        
    For k = 1 To UBound(fAr)
        If eAr(i, 1) = fAr(k, 1) Then
            eh = eh + 0.02
        End If
    Next k
        
    For l = 1 To UBound(nAr)
        If eAr(i, 1) = nAr(l, 1) Then
            eh = eh + 0.003
        End If
    Next l
    
    LastRow = ws1.Range("B" & Rows.Count).End(xlUp).Row

    Select Case eh
        Case 0
            ws1.Range("A" & LastRow + 1).Value = eAr(i, 1)
            ws1.Range("B" & LastRow + 1).Value = "1A"
        Case 0.1
            ws1.Range("A" & LastRow + 1).Value = eAr(i, 1)
            ws1.Range("B" & LastRow + 1).Value = "1B"
        Case 0.02, 0.003, 0.023
            ws1.Range("A" & LastRow + 1).Value = eAr(i, 1)
            ws1.Range("B" & LastRow + 1).Value = "2A"
        Case 0.12, 0.103, 0.123
            ws1.Range("A" & LastRow + 1).Value = eAr(i, 1)
            ws1.Range("B" & LastRow + 1).Value = "2B"
        End Select
Next i

For i = 1 To UBound(hAr)
    eh = 0
    
    For j = 1 To UBound(eAr)
        If hAr(i, 1) = eAr(j, 1) Then
            eh = eh + 0.1
        End If
    Next j
        
    For k = 1 To UBound(fAr)
        If hAr(i, 1) = fAr(k, 1) Then
            eh = eh + 0.02
        End If
    Next k
        
    For l = 1 To UBound(nAr)
        If hAr(i, 1) = nAr(l, 1) Then
            eh = eh + 0.003
        End If
    Next l
    
    LastRow = ws1.Range("B" & Rows.Count).End(xlUp).Row

    Select Case eh
        Case 0
            ws1.Range("A" & LastRow + 1).Value = hAr(i, 1)
            ws1.Range("B" & LastRow + 1).Value = "1B"
        Case 0.02, 0.023, 0.003
            ws1.Range("A" & LastRow + 1).Value = eAr(i, 1)
            ws1.Range("B" & LastRow + 1).Value = "2B"
        End Select
Next i

For i = 1 To UBound(fAr)
    eh = 0
    
    For j = 1 To UBound(eAr)
        If fAr(i, 1) = eAr(j, 1) Then
            eh = eh + 0.1
        End If
    Next j
        
    For k = 1 To UBound(hAr)
        If fAr(i, 1) = hAr(k, 1) Then
            eh = eh + 0.02
        End If
    Next k
        
    For l = 1 To UBound(nAr)
        If fAr(i, 1) = nAr(l, 1) Then
            eh = eh + 0.003
        End If
    Next l
    
    LastRow = ws1.Range("B" & Rows.Count).End(xlUp).Row

    Select Case eh
        Case 0
            ws1.Range("A" & LastRow + 1).Value = hAr(i, 1)
            ws1.Range("B" & LastRow + 1).Value = "2C"
    End Select
Next i

For i = 1 To UBound(nAr)
    eh = 0
    
    For j = 1 To UBound(eAr)
        If nAr(i, 1) = eAr(j, 1) Then
            eh = eh + 0.1
        End If
    Next j
        
    For k = 1 To UBound(hAr)
        If nAr(i, 1) = hAr(k, 1) Then
            eh = eh + 0.02
        End If
    Next k
        
    For l = 1 To UBound(fAr)
        If nAr(i, 1) = fAr(l, 1) Then
            eh = eh + 0.003
        End If
    Next l
    
    LastRow = ws1.Range("B" & Rows.Count).End(xlUp).Row

    Select Case eh
        Case 0
            ws1.Range("A" & LastRow + 1).Value = hAr(i, 1)
            ws1.Range("B" & LastRow + 1).Value = "No Impact"
    End Select
Next i

'ws1.Range("A1").Resize(UBound(eAr, 1), UBound(eAr, 2)).Value = eAr
'ws1.Range("A1").Resize(UBound(eAr, 1), UBound(eAr, 2)).Value = hAr
    

End Sub