CODEWITHSUNDEEP
vbaexcelconcatenationvlookup
ABS
ABS

Reputation: 1

VBA - CONCATENATE + VLOOKUP with Scripting Dictionary

I am trying to create a macro of a report that I create monthly. I've been working on this for almost two weeks. and I am stuck.Below is the spreadsheet I have. "data" sheet is my source data and "new_table" is the normalize one that I need. To normalize the data i created column category which is a concatenate of user_id and question_id.

Note *I work with 400K row thus I am trying to implement this with the scripting dictionary vlookup *I need to concatenate row and column in "new_table" to get the category to match with the answer *I copy the unique cell from category in "data" and transpose to "new_table" row 1 to make it as a header

Sheet ("data") user_id question id category answer user1 ques1 user1ques1 yes user2 ques1 user2ques1 no user1 ques2 user1ques2 yes

Sheet ("new_table") user_id user1ques1 user2ques1 user1ques2 user1 yes N/A yes user2 N/A no N/A

I am unable to create a vba to allow me to vlookup column category, answer from "data" and match it with concatenate column and row from "new_table"

Here is what I have so far which is not much. I am still stuck with trying to working out the vlookup I have look into concatenate and dynamic of the potentially different column numbers in "new_table". Please help

Dim x, i&, s$
With Sheets("data")
x = .Range("A2:D" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(x)
s = x(i, 1): .Item(s) = x(i, 3)
Next i
With Sheets("new_table")
x = .Range("A2:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
For i = 2 To UBound(x)
s = x(i, 1)
If .Exists(s) Then x(i, 1) = .Item(s) Else x(i, 1) = vbNullString
Next i
End With
Sheets("new_table").Range("B2").Resize(i - 1).Value = x

Upvotes: 0

Views: 1881

Answers (1)

peege
peege

Reputation: 2477

This is a component of your solution. I'm still not exactly sure about which values you are trying to concatenate. I will update after comments.
TESTED:

Private Sub UniqueColHeaders()

Dim rng As Range
Dim Dn As Range
Dim Dic As Object
Dim colNum As Long

'Get the unique values in Category from "Data" if Category is Column C

Worksheets("data").Select
Set rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
    Set Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
For Each Dn In rng
    If Not Dn = vbNullString Then Dic(Dn.Value) = Empty
Next

'Now set the column headers on "new_table"
colNum = 2
For Each Item In Dic
    Sheets("new_table").Cells(1, colNum).Value = Item
    colNum = colNum + 1
Next

End Sub

Upvotes: 1

Related Questions