VBA help to Vlookup a single value in a list and return results while ignoring blank cells

[MMC78]

Hi,

I've been messing about with this and can't quite seem to get it right (I also think I'm making things much more complicated than they need to be!).

Below is an example of the data I have.....(the real data has many more ref and ID numbers). I want to macro this as this is a task I want to run daily, and the data will change on a day to day basis.

Ref	ID1	ID2				Ref2
1		305				1	add data here	add data here	add data here
1	324					2
1		434, 543				3
1						4	569
1	305	126				5	377	432	588
1
2	126
2	427
2		512
2
2	512
2		569
2
2
2	312
3		324
3	453, 478	126
4
4		569
4	569
5
5	377
5		432
5	432	588

<tbody>
</tbody>

Take the list of Ref numbers from column (Ref) and remove duplicates in column (Ref2) as above.

Then for each Ref in Ref2 column run a lookup for that Ref in column (Ref) and return all IDs from columns (ID1 and ID2), while ignoring blanks and duplicates, and to paste them in the row for each ref (see above). I'm not fussed if the data is pasted in individual cells or is a string in a single cell - see column (Ref2) ref 4 and 5 above for a simple example of how this should look.

 

[MMC78]

Hi,

I've been messing about with this and can't quite seem to get it right (I also think I'm making things much more complicated than they need to be!).

Below is an example of the data I have.....(the real data has many more ref and ID numbers). I want to macro this as this is a task I want to run daily, and the data will change on a day to day basis.

Ref	ID1	ID2				Ref2
1		305				1	add data here	add data here	add data here
1	324					2
1		434, 543				3
1						4	569
1	305	126				5	377	432	588
1
2	126
2	427
2		512
2
2	512
2		569
2
2
2	312
3		324
3	453, 478	126
4
4		569
4	569
5
5	377
5		432
5	432	588

<tbody>
</tbody>

Take the list of Ref numbers from column (Ref) and remove duplicates in column (Ref2) as above.

Then for each Ref in Ref2 column run a lookup for that Ref in column (Ref) and return all IDs from columns (ID1 and ID2), while ignoring blanks and duplicates, and to paste them in the row for each ref (see above). I'm not fussed if the data is pasted in individual cells or is a string in a single cell - see column (Ref2) ref 4 and 5 above for a simple example of how this should look.

Anyone??/

 

[Snakehips]

MMC78,

Not sure if the below code will deal with all eventualities but I believe it deals with your example data.

Sub RefIDs()


Range("G1") = "Ref2"
R2r = 1
lr = Cells(Rows.Count, "A").End(xlUp).Row
For Each Cell In Range("A2:A" & lr)
    If Cell <> PrevCell Then
        R2r = R2r + 1
        Range("G" & R2r) = Cell
        PrevCell = Cell
        NewRef = "Y"
        IDOset = 1
    End If
    
      For CellOset = 1 To 2
            If Not Cell.Offset(0, CellOset) = "" Then
             If NewRef = "Y" Then
                    Range("G" & R2r).Offset(0, IDOset) = Cell.Offset(0, CellOset)
                    PrevID = Cell.Offset(0, CellOset)
                     IDOset = IDOset + 1
                     NewRef = "N"
                     Else
              
                      If Not Cell.Offset(0, CellOset) = PrevID Then
                        Range("G" & R2r).Offset(0, IDOset) = Cell.Offset(0, CellOset)
                        PrevID = Cell.Offset(0, CellOset)
                        IDOset = IDOset + 1
                     End If
                End If
            End If
        
      Next CellOset
        
Next Cell


End Sub

Hope that helps.

 

[MMC78]

MMC78,

Not sure if the below code will deal with all eventualities but I believe it deals with your example data.

Sub RefIDs()


Range("G1") = "Ref2"
R2r = 1
lr = Cells(Rows.Count, "A").End(xlUp).Row
For Each Cell In Range("A2:A" & lr)
    If Cell <> PrevCell Then
        R2r = R2r + 1
        Range("G" & R2r) = Cell
        PrevCell = Cell
        NewRef = "Y"
        IDOset = 1
    End If
    
      For CellOset = 1 To 2
            If Not Cell.Offset(0, CellOset) = "" Then
             If NewRef = "Y" Then
                    Range("G" & R2r).Offset(0, IDOset) = Cell.Offset(0, CellOset)
                    PrevID = Cell.Offset(0, CellOset)
                     IDOset = IDOset + 1
                     NewRef = "N"
                     Else
              
                      If Not Cell.Offset(0, CellOset) = PrevID Then
                        Range("G" & R2r).Offset(0, IDOset) = Cell.Offset(0, CellOset)
                        PrevID = Cell.Offset(0, CellOset)
                        IDOset = IDOset + 1
                     End If
                End If
            End If
        
      Next CellOset
        
Next Cell


End Sub

Hope that helps.

Hi Snakehips,

Yes, that works great on my example data. I've tried it on the live data and it is working for most records, but no issue there as this is a great starting point for me so I can tidy up from here.

Thanks for you assistance!