copy loop array to a column

[raufbold]

Hello, I'm trying to make a macro for updating a source list. Sheet1 has a list of items with different attributes (attributes are listed in column B, separated by commas). All these attributes are also listed in column A on Sheet2, each unique attribute in its cell (for reference, as a "Glossary").
I want to have a macro which, when run, will analyze Sheet1 column B for attributes that are not listed in column A of Sheet2, add them to that column and paint them red.
I have come up with a code which does it, with attributes from column B of Sheet1 stored in an array. Array is temporary copied to column A of Sheet3 and used as a reference for pasting data into Sheet2.
The only problem I have is that the array is a loop and it copies only the last instance of the loop into Sheet3, overwriting all the previous loops.
Can someone help me deal with that?
Here's my code:

Dim Outputs As Variant, Outputname As Variant, splitout As Variant
 
Sub updt()
 Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr As Long, rng As Range
 
 Application.ScreenUpdating = False
 Set sh1 = Sheets("Sheet1")
 Set sh2 = Sheets("Sheet2")
 Set sh3 = Sheets("Sheet3")
 
 With ThisWorkbook.Worksheets("Sheet1")
        Outputs = .Range("B2", .Range("B1").End(xlDown)).Value
 End With


 For Each Outputname In Outputs
        splitout = Split(Outputname, ",")
            For z = 1 To UBound(splitout)
                Debug.Print splitout(z)
               [COLOR=#008000] 'this is where I'm trying to copy array splitout to Sheet3, and it only copies the last instance of z:[/COLOR]
                With ThisWorkbook.Worksheets("Sheet3")
                Cells(z, 1).Value = splitout(z)
                End With
            Next z
       
 Next Outputname
 
 
 lr = sh3.Cells(Rows.Count, 1).End(xlUp).Row
 Set rng = sh3.Range("A1:A" & lr)
 For Each c In rng
 If WorksheetFunction.CountIf(sh2.Range("A:A"), c.Value) = 0 Then
 sh2.Range("A" & sh2.Cells(Rows.Count, 1).End(xlUp).Row)(2) = c.Value
 With sh2.Range("A" & sh2.Cells(Rows.Count, 1).End(xlUp).Row)
 .Font.Color = vbRed
 End With
 End If
 Next
 Sheets("Sheet3").Cells.Clear
 Application.ScreenUpdating = True
 End Sub

 

[JoeMo]

z resets for each loop, that's why you are overwriting. Also, the lower bound of the split function is 0 not 1.

Try this (untested) to see if it gives you what you want. I haven't looked at the rest of your code.

Dim ct As Long
For Each Outputname In Outputs
        splitout = Split(Outputname, ",")
            For Z = Lbound(splitout) To UBound(splitout)
                ct = ct + 1
                With ThisWorkbook.Worksheets("Sheet3")
                Cells(ct, 1).Value = splitout(Z)
                End With
            Next Z
 Next Outputname

 

[raufbold]

That worked, thanks. Though for me Z = 1 To UBound(splitout) worked better, as it doesn't divide the results by an empty row.

Had some really weird problems with With ThisWorkbook.Worksheets("Sheet3") function, as for a while it didn't recognize the worksheet and would just post it on Sheet1. Sorted out by itself somehow.

 

[JoeMo]

That worked, thanks. Though for me Z = 1 To UBound(splitout) worked better, as it doesn't divide the results by an empty row.

Had some really weird problems with With ThisWorkbook.Worksheets("Sheet3") function, as for a while it didn't recognize the worksheet and would just post it on Sheet1. Sorted out by itself somehow.

You are welcome - glad you sorted out the problems.