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:
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:
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