VBA Help - Find, Cross Reference, Copy/Paste

MrGrey

New Member
Joined
Oct 8, 2014
Messages
4
I'm trying to extract key information from a range; below is an example of a sample data set I'm working with (unique IDs can exceed 100, unique Types can exceed 10, Value is variable). The source data is random with each sampling but always arranged by Value, Type, ID. I need to extract the Values associated to Type 2 & 3 (always 2&3) for each ID and then copy those Values to the Destination cells according to ID and Type.

So the macro needs to look at the source data and find Type 2&3 in column 2 then take the Value associated with it in column 1 then cross reference the ID# in column 3 and copy those two Values then past them into the destination cells for the Type 2&3 Values that are associated with each ID#. For users with no Type 2&3 Values blank cells are fine.

You can assume source columns are A, B C and destination columns are E, F, G . I can manipulate these values to make it put the data where I need it.

I already have a method for finding the unique IDs and creating the "destination". But this multiple variable reference is beyond my current skill set. I've seriously been hurting my brain for a couple weeks on this one.:confused:

Thanks for anyone who can point me in the right direction.

SourceDestination
ValueType 1ID 1Type 2Type 3
ValueType 2ID 1ID 1ValueValue
ValueType 3ID 1ID 2
ValueType 4ID 1ID 3Value
ValueType 1ID 2ID 4Value
ValueType 5ID 3
ValueType 3ID 3
ValueType 2ID 4
ValueType 6ID 4

<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

NeonRedSharpie

Well-known Member
Joined
Jul 14, 2014
Messages
1,678
Sure is!

Code:
Sub moveData()

    For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
        For y = 2 To Cells(Rows.Count, 4).End(xlUp).Row Step 1
        
            If Cells(x, 3) = Cells(y, 4) Then
                Select Case Cells(x, 2)
                    Case "Type 2"
                        Cells(y, 5) = Cells(x, 1)
                    Case "Type 3"
                        Cells(y, 6) = Cells(x, 1)
                    Case Else
                End Select
            End If
        Next y
    Next x

End Sub


This assumes some of the "Destination" is already built. Allow me to make it a bit more fluid.



Code:
Sub moveData()

    Columns(4).Value = Columns(3).Value


    Range(Cells(1, 4), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 4)) _
        .RemoveDuplicates Columns:=1, Header:=xlNo
    Cells(1, 4).Insert Shift:=xlDown
    Cells(1, 5) = "Type 2"
    Cells(1, 6) = "Type 3"


    For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
        For y = 2 To Cells(Rows.Count, 4).End(xlUp).Row Step 1
        
            If Cells(x, 3) = Cells(y, 4) Then
                Select Case Cells(x, 2)
                    Case Cells(1, 5)
                        Cells(y, 5) = Cells(x, 1)
                    Case Cells(1, 6)
                        Cells(y, 6) = Cells(x, 1)
                    Case Else
                End Select
            End If
        Next y
    Next x
End Sub

I like the first one better...but this one has a bit more flexibility.
 
Last edited:

MrGrey

New Member
Joined
Oct 8, 2014
Messages
4
This is great thank you! I'll give it a try and see what I can make it do. I'll report backonce I've got a chance to try it out.

I was up past 5am so I'm having a hard time following the logic by playing it out in my head lol.
 

MrGrey

New Member
Joined
Oct 8, 2014
Messages
4
Neon, this is a pretty piece of code! So simple and effective and chews through 200 or so lines of data in a flash! I've never used Case before but now that I've wrapped my head around it I'll be using it more. Thank you!

On the second version you wrote the "remove duplicates" portion is creating a double entry for the first ID once I edited it. I've has this problem before with remove duplicates but I can't seem to figure out why.

I don't need this portion of the code so it's not a big deal. It's more for future reference so I know how to fix it.

This is what I did to it. I'm sure I messed something up.

Code:
Columns(5).Value = Columns(3).Value


    Range(Cells(2, 5), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 5)) _
        .RemoveDuplicates Columns:=1, Header:=xlNo
    Cells(1, 5).Insert Shift:=xlDown
 

Watch MrExcel Video

Forum statistics

Threads
1,122,228
Messages
5,594,935
Members
413,953
Latest member
Arthur1471

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top