Need some help with an Excel macro-- I'm currently struggling to write a macro that combines all three processes. I have two sheets: Sheet 1 contains a column with multiple IDs in each cell delimited by commas (can go up to like 30 IDs in one cell), Sheet 2 contains data for each of the IDs.
Here's the sequence that I'm trying to achieve:
- De-concatenate IDs in Sheet 1 into separate cells
- Match each of the de-concatenated IDs to its row in Sheet 2, copy over and add values from column 6 and 7 to Sheet 1's respective cell.
- Apply a hyperlink to the final cell.
For example, here's what a row in Sheet 1 & 2 currently look like:
Sheet 1
ID |
---|
123456, 789123 |
Sheet 2
ID | Status | Class |
---|---|---|
123456 | In Progress | A |
789123 | Done | B |
And here's what I'd like the output to look for Sheet 1 when the macro runs:
ID | ||
---|---|---|
123456, 789123 | 123456, In Progress, A | 789123, Done, B |
My code is super off, but here's what I have:
Set wb = ThisWorkbook
Dim sel As Range
Set sel = Selection
Dim arr() As String
Dim cell As Range
Dim i As Long
Set wsCheck = wb.Sheets("2")
'Column N (IDs)
wb.Sheets("1").Columns("N:N").Select
For Each cell In sel
arr = Split(cell, ",")
For i = 0 To UBound(arr)
m = Application.Match("*" & arr(i) & "*", wsCheck.Columns(1), 0)
If Not IsError(m) Then
cell.Offset(0, i 1).Value = wsCheck.Cells(m, 6).Value & wsCheck.Cells(m, 7).Value
cell.Parent.Hyperlinks.Add Anchor:=cell.Offset(0, i 1), Address:="URL" & arr(i), TextToDisplay:=arr(i)
End If
Next i
Next cell
CodePudding user response:
Try this:
Sub test()
Dim wb As Workbook, arr, ws As Worksheet, wsCheck As Worksheet
Dim cell As Range
Dim i As Long, v, m
Set wb = ThisWorkbook
Set ws = wb.Sheets("1")
Set wsCheck = wb.Sheets("2")
If Not TypeOf Selection Is Range Then Exit Sub 'make sure a range is selected
If Selection.Worksheet.Name <> ws.Name Then Exit Sub '...on the correct sheet
For Each cell In Selection.EntireRow.Columns("N").Cells
arr = Split(cell.Value, ",")
For i = 0 To UBound(arr)
v = CLng(Trim(arr(i))) 'remove spaces and convert to number
m = Application.Match(v, wsCheck.Columns(1), 0)
If Not IsError(m) Then
With cell.Offset(0, i 1)
.Value = Join(Array(v, wsCheck.Cells(m, 6).Value, _
wsCheck.Cells(m, 7).Value), ",")
.Parent.Hyperlinks.Add Anchor:=.Cells(1), _
Address:="", _
SubAddress:=wsCheck.Cells(m, 1).Address(0, 0, xlA1, True), _
TextToDisplay:=.Value
End With
End If
Next i
Next cell
End Sub