Finding the missing values based on criteria in Column C - vba

Question

I have a value in column C which in some cases are duplicated, where there are duplicates I want it to look in column Z for the corresponding ID if none exist I want it to check where whether any other values in column C have a value in Column Z and then add the missing values into column Z accordingly:
Column C Column Z
45519 Blank*
45519 1
456 2
456 *Blank
Expected result:
Column C: Column Z
45519 1
45519 1
456 2
456 2
Stackoverflow Code I have adapted to use 1 and 24 respectively.
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("transactions")
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Dim dataArr()
dataArr = ws.Range("C1:Z" & lastRow).Value
Dim currentRow As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For currentRow = LBound(dataArr, 1) To UBound(dataArr, 2)
If Not IsEmpty(dataArr(currentRow, 2)) And Not dict.Exists(dataArr
(currentRow, 1)) Then
dict.Add dataArr(currentRow, 1), dataArr(currentRow, 2)
End If
Next currentRow
For currentRow = LBound(dataArr, 1) To UBound(dataArr, 1)
If IsEmpty(dataArr(currentRow, 2)) Then
dataArr(currentRow, 2) = dict(dataArr(currentRow, 1))
End If
Next currentRow
ws.Range("C1").Resize(UBound(dataArr, 1), UBound(dataArr, 2)) = dataArr
End Sub
I am receiving no result in column Z as a result of this

Answer 1

Try this. Amended column references as per comments, plus I think your first loop was unnecessarily long. You'll need to change the 24s if your array is actually of a different size.
Option Explicit
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Worksheets("transactions")
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Dim dataArr()
dataArr = ws.Range("C1:Z" & lastRow).Value
Dim currentRow As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For currentRow = LBound(dataArr, 1) To UBound(dataArr, 1)
If Not IsEmpty(dataArr(currentRow, 24)) And Not dict.Exists(dataArr(currentRow, 1)) Then
dict.Add dataArr(currentRow, 1), dataArr(currentRow, 24)
End If
Next currentRow
For currentRow = LBound(dataArr, 1) To UBound(dataArr, 1)
If IsEmpty(dataArr(currentRow, 24)) Then
dataArr(currentRow, 24) = dict(dataArr(currentRow, 1))
End If
Next currentRow
ws.Range("C1").Resize(UBound(dataArr, 1), UBound(dataArr, 2)) = dataArr
End Sub
Alternative method
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Worksheets("transactions")
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Dim r As Range, r1 As Range, s As String
For Each r In ws.Range("Z1:Z" & lastRow).SpecialCells(xlCellTypeBlanks)
Set r1 = ws.Range("C1:C" & lastRow).Find(ws.Cells(r.Row, "C"), , , xlWhole)
If Not r1 Is Nothing Then
s = r1.Address
Do Until r1.Row <> r.Row
Set r1 = ws.Range("C1:C" & lastRow).FindNext(r1)
If r1.Address = s Then Exit Do
Loop
r.Value = ws.Cells(r1.Row, "Z")
End If
Next r
End Sub

Answer 2

There is some tidying up to do. Currently assumes data starts in row 2.
Option Explicit
Public Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("transactions")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Dim unionRng As Range
Set unionRng = Union(ws.Range("C2:C" & lastRow), ws.Range("Z2:Z" & lastRow))
Dim dataArray()
Dim numberOfColumns As Long
numberOfColumns = unionRng.Areas.Count
ReDim dataArray(1 To lastRow, 1 To numberOfColumns) '1 could come out into variable startRow
Dim currRow As Range
Dim columnToFill As Long
For columnToFill = 1 To numberOfColumns
For Each currRow In unionRng.Areas(columnToFill)
dataArray(currRow.Row - 1, columnToFill) = currRow 'assume data starts in row 1 otherwise if 2 then currRow.Row -1 etc
Next currRow
Next columnToFill
Dim currentRow As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)
If Not IsEmpty(dataArray(currentRow, 2)) And Not dict.Exists(dataArray(currentRow, 1)) Then
dict.Add dataArray(currentRow, 1), dataArray(currentRow, 2)
End If
Next currentRow
For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)
If IsEmpty(dataArray(currentRow, 2)) Then
dataArray(currentRow, 2) = dict(dataArray(currentRow, 1))
End If
Next currentRow
ws.Range("Z2").Resize(UBound(dataArray, 1), 1) = Application.Index(dataArray, 0, 2)
End Sub

Answer 3

you could very simply go like follows
Option Explicit
Sub main()
Dim cell As Range, IdsRng As Range
With Worksheets("transactions") 'reference wanted sheet
Set IdsRng = .Range("Z2", .Cells(.Rows.Count, "Z").End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants, xlNumbers) 'get all IDs from its column Z cells with constant numeric value
With .Range("C1", .Cells(.Rows.Count, "C").End(xlUp)) 'reference referenced sheet column C cells from row 1 (header) down to last not empty one
For Each cell In IdsRng 'loop through all IDs
.AutoFilter Field:=1, Criteria1:=cell.Offset(, -23).value ' filter referenced cells on 1st column with passed ID content 'filter referenced range with current ID
.Offset(1, 23).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).value = IdsRng.value 'write all filtered cells corresponding values in column Z with current ID
Next
End With
.AutoFilterMode = False
End With
End Sub