I have this Macro already working:
Sub ListSheetsValuesAreOn()
Dim X As Long, Data As Variant, Uniques As String, SH As Worksheet, NewSH As Worksheet
With CreateObject("Scripting.Dictionary")
For Each SH In Worksheets
Data = Application.Transpose(SH.Range("C23", SH.Cells(Rows.Count, "C").End(xlUp)))
For X = 1 To UBound(Data)
If IsEmpty(.Item(Data(X))) Then
.Item(Data(X)) = Data(X) & "|" & SH.Name
ElseIf Data(X) = Split(.Item(Data(X)), "|")(0) And _
Not .Item(Data(X)) Like "*|*" & SH.Name & "*" Then
.Item(Data(X)) = .Item(Data(X)) & ", " & SH.Name
End If
Next
Next
Sheets.Add After:=Sheets(Sheets.Count)
Set NewSH = ActiveSheet
NewSH.Range("A1").Resize(.Count) = Application.Transpose(.Items)
End With
NewSH.Name = "Result Sheet"
NewSH.Columns("A").TextToColumns , xlDelimited, , , 0, 0, 0, 0, 1, "|"
NewSH.Columns("A:B").AutoFit
End Sub
What this script does is: Read values in C column and search all the workbook to find these values. Returning the values and the sheets where they've been found. But I want to return not each value in C but the next one in column D. Example:
Sheets 1...n Expected output (new sheet)
C | D A | B
item 1|description of item 1 description of item 1|1,4,6
item 2|description of item 2 description of item 2|3,7,11,12
... | .... .... | .....
item m|description of item m description of item m| 5,9,15,24
Please try this one:
Sub Answer()
Dim dict As Object
Dim Data As Variant
Dim ws As Worksheet
Dim rng As Range
Set dict = CreateObject("Scripting.Dictionary")
With dict
For Each SH In Worksheets
Data = Application.Transpose(SH.Range("C23", SH.Cells(Rows.Count, "D").End(xlUp)))
For X = LBound(Data, 2) To UBound(Data, 2)
If IsEmpty(.Item(Data(1, X))) Then
.Item(Data(1, X)) = Data(2, X) + "|" + SH.Name
'.Item(Data(2, X)) = .Item(Data(1, X))
ElseIf Split((dict.Item(Data(1, X))), "|")(0) = Split((Data(2, X)), "|")(0) Then
.Item(Data(1, X)) = .Item(Data(1, X)) + ", " + SH.Name
End If
Next X
Next
Sheets.Add After:=Sheets(Sheets.Count)
Set NewSH = ActiveSheet
NewSH.Range("A1").Resize(.Count) = Application.Transpose(.Items)
End With
NewSH.Name = "Result Sheet"
NewSH.Columns("A").TextToColumns , xlDelimited, , , 0, 0, 0, 0, 1, "|"
NewSH.Columns("A:B").AutoFit
End Sub