VBA: VLookup Multi Range

[willard8]

I have searched extensively and have not been able to find an answer yet that depicts what I am trying to do. I have two sheets. Sheet("Stats") holds all the information that is exported from my userform. I would like Sheet("Athens") to hold certain information from "Stats". I am trying to use VBA with Vlookup to do this and have not been able to come up with a working solution. I am checking "Stats" Column B for "Athens"; if Athens is the cell.text I would like Columns C, D, & F to copy over to Sheet("Athens") in Columns A, B, & C respectively. I need this to loop for all ranges in Column B on "Stats". If there is a better way to go about accomplishing this task I am all ears. Any suggestions would be greatly appreciated! Below is the code I was toying with, but have not had any luck.

<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> RbtnPublish1_Click()<br><SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>Sheets("Stats").Activate<br><br><SPAN style="color:#00007F">Dim</SPAN> Vrng, Vrng1 <SPAN style="color:#00007F">As</SPAN> Range<br><br><SPAN style="color:#00007F">Set</SPAN> Vrng1 = Sheets("Athens").Range("A3", Range("A3").End(xlDown)).Activate<br><br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> Vrng <SPAN style="color:#00007F">In</SPAN> Sheets("Stats").Range("B1", Range("B1").End(xlDown))<br><br>        <SPAN style="color:#00007F">If</SPAN> IsNumeric(Vrng) = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN><br><br>            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Vrng<br><br>                <SPAN style="color:#00007F">Case</SPAN> Vrng = "Athens": Vrng1.Formula = "=VLOOKUP('Athens', Vrng, 3, True)"<br><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><br>    <SPAN style="color:#00007F">Next</SPAN> Vrng<br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Thanks in advance for your help!

Will

 

[Datsmart]

This code will copy as you are requesting:

Private Sub RbtnPublish1_Click()
On Error Resume Next
Dim Vrng, Vrng1 As Range
Set Vrng1 = Sheets("Athens").Range("A3", Range("A3").End(xlDown)) '.Activate
    For Each Vrng In Sheets("Stats").Range("B1", Range("B1").End(xlDown))
        If Vrng.Value = "Athens" Then
            vr = Vrng.Row
            Sheets("Athens").Cells(vr, "A").Value = Sheets("Stats").Cells(vr, "C").Value
            Sheets("Athens").Cells(vr, "B").Value = Sheets("Stats").Cells(vr, "D").Value
            Sheets("Athens").Cells(vr, "C").Value = Sheets("Stats").Cells(vr, "F").Value
        End If
    Next Vrng
End Sub

It copies to the same row number as the source. If you want the values copied to a different row, that can be adjusted. Let me know where you want it copied to.