Hi Gurus,
I'm hoping you can help me improve a bit of code that I cobbled together as a VBA novice. The basic premise is to convert a matrix to a list. My matrix (Table 1) includes unique ID, personal info, unique key (same as unique ID) and assigned roles where an "X" matches the name (row) with the role (column). It is easy to create the reverse pivot table (Table 2) and the result is a table with Unique ID, Role, and 'X'. The code below goes back to Table 1 and stiches back personal info by matching unique ID (Table 1) with Unique Key (Table 2). It works - just VERRRRY slow as there will be 10-20k lines on Table 2.
Table 1 (the matrix). In my code it is called 'RDBMergeSheet'
Unique ID - Personal info - Unique Key (same as unique ID) - Roles (indicated with an X in the cell which aligns with the appropriate role column. There are multiple Xs)
Table 2 (the reverse pivot). In my code it is called 'Data Table'
Unique Key - Role (now as a title). I filtered and removed all blanks. Note that the same unique key will appear for each role that that user has
Goal
I want to add the Unique ID's personal info from Table 1 for each Unique Key.
Sub Fill_Info()
'fills End User Info into Data Table worksheet
Dim LastC As Long
Dim LastR As Long
Dim LastR2 As Long
Dim l As Long
Dim i As Integer
Dim d As Long
Dim ColCount As Long
Dim Dept_Row As Long
Dim Dept_Clm As Long
Dim ID As Range
Dim foundID As Range
Dim DTableLastC As Long
Dim DTableLastR As Long
Dim Dtablel As Long
Sheets("RDBMergeSheet").Select
LastC = LastCol(ActiveSheet)
LastR = LastRow(ActiveSheet)
'assums unique user key column is between A1 and Z1
l = Application.WorksheetFunction.Match("Unique User Key", Range("A1:Z1"), 0)
ActiveSheet.Range(Cells(2, 1), Cells(LastR, l - 1)).Name = "info_Range"
Range("info_range").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Data Table").Select
LastR2 = LastRow(ActiveSheet)
ActiveSheet.Range(Cells(2, 1), Cells(LastR2, 1)).Name = "Unique_Keys"
ColCount = Range("info_range").Columns.Count
ActiveSheet.Range(Cells(1, 1), Cells(1, ColCount)).Name = "Unique_Keys_Col"
For Each ID In Sheets("data table").Range("A2:A" & LastR2)
Set foundID = Sheets("RDBMergeSheet").Range("A:A").find(ID, LookIn:=xlValues, lookat:=xlWhole)
If Not foundID Is Nothing Then
Worksheets("RDBMergeSheet").Cells(foundID.Row, 2).Resize(, ColCount).Copy Sheets("data table").Range("D" & ID.Row)
End If
Next ID
Application.Goto Reference:="Header_Range"
Selection.Copy
Sheets("Data Table").Select
Range("D1").Select
ActiveSheet.paste
Application.CutCopyMode = False
' Defines the range for the Data Pivot Table
Sheets("Data Table").Select
DTableLastC = LastCol(ActiveSheet)
DTableLastR = LastRow(ActiveSheet)
ActiveSheet.Range(Cells(1, 1), Cells(DTableLastR, DTableLastC)).Name = "Data_Pivot_Table"
End Sub