What is my mistake to border a specific range up to the last row with an entry?

Question

i tried on more ways to border the result of the variable V2 in Column E but it doenst work. You can see my tryings as a comment within the code. Has anyone an idea? Thanks

---

By the way is it possible to figure out End(xlUp) & End(xlDown) just by a Macro?

Update

This i could figure out by pressing shift +Cntrl + ArrowDown

---

Sub Duplicate()
    
    Dim nA As Long, nD As Long, i As Long, rc As Long
    Dim s As String, j As Long
    'Dim LastRow As Long
    'Dim rng2 As Range
    
    
    
        Range("A:A").Copy Range("D1")
        Range("B1").Copy Range("E1")
        Range("D:D").RemoveDuplicates Columns:=1, Header:=xlYes
        rc = Rows.Count
        nA = Cells(rc, 2).End(xlUp).Row 'grün
        nD = Cells(rc, 4).End(xlUp).Row 'gelb
       
           For i = 2 To nD 'gelb
            v = Cells(i, 4) 'gelb
            V2 = "" 'rot
            For j = 2 To nA 'grün
                If v = Cells(j, 1) Then 'orange
                    V2 = V2 & "," & Cells(j, 2) 'rot / ZU UMRANDEN
                End If
            Next j
            Cells(i, 5) = Mid(V2, 1) 'rot / 1 = Start erstes Zeichen
        Next i
        
        'LastRow = Cells(Rows.Count, 5).End(xlUp).Row
        'Range("E:E" & LastRow).Borders (xlInsideHorizontal)
        
     
        'Set rng2 = ActiveSheet.Range("E:E", ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp))
        '   rng2.HorizontalAlignment = xlLeft
    
        'With rng2.Borders()
        '       .LineStyle = xlContinuous
        '      .ColorIndex = 0
        '     .TintAndShade = 0
        '    .Weight = xlThin
            
    'End With
    
    Debug.Print
        
End Sub

Update

How it is right now

How it shall be

Update

final need had been like this

Answer 1

From what I have understood, you are using remove duplicates on Col A values pasted in Column D (Code not there in question I guess) and then match the values with Col A to collate the values from Col B to create a summary kind of thing.

If my understanding is correct then there is a simpler way to do it.

LOGIC

1. Identify your range and store the values in an array. This is to speed things up. To identify the range, you can find the last row as shown HERE and then use that range.

2. Create a unique collection of values from Col A.

3. Define a second array based on unique values.

4. Compare the unique values with values in Col A and collate the values from Col B.

5. Clear Column D and E for output and finally output the array there.

6. Identify the final range to work with. You can then add color, border etc to that range.

CODE

I have commented the code but if you still have problems understanding it then do let me know.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long, j As Long
    Dim MyAr As Variant, OutputAr As Variant
    Dim col As New Collection
    Dim itm As Variant
    Dim tmpString As String
    Dim rng As Range
    
    '~~> Change this to the relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~> Find the last row in column A
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        '~~> Store the Col A and B values in an array
        MyAr = .Range("A1:B" & lRow).Value2
        
        '~~> Loop through the array and get unique values from Col A
        For i = LBound(MyAr) To UBound(MyAr)
            On Error Resume Next
            col.Add MyAr(i, 1), CStr(MyAr(i, 1))
            On Error GoTo 0
        Next i
    End With
    
    '~~> Define your output array based on unique values found
    ReDim OutputAr(1 To col.Count, 1 To 2)
      
    j = 1
    '~~> Compare the unique values with values in Col `A`
    '~~> and collate the values from Col `B`
    For Each itm In col
        OutputAr(j, 1) = itm
        
        tmpString = ""
        
        For i = LBound(MyAr) To UBound(MyAr)
            If MyAr(i, 1) = itm Then
                tmpString = tmpString & "," & MyAr(i, 2)
            End If
        Next i
        
        OutputAr(j, 2) = "'" & Mid(tmpString, 2)
        j = j + 1
    Next itm
    
    With ws
        '~~> Clear Col D and E for output
        .Columns("D:E").Clear
        
        '~~> Output the array
        .Range("D1").Resize(col.Count, 2).Value = OutputAr
        
        '~~> This is the final range
        Set rng = .Range("D1:E" & col.Count)
        
        With rng
            MsgBox .Address
            '
            '~~> Do what you want with the range here
            '
        End With
    End With
End Sub

IN ACTION

An example to add borders

With rng
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    
    For i = 7 To 12
        With .Borders(i)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    Next i
End With

Output

Similarly to center align the text

With rng
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

Output