Find and copy from another sheet?

[saupton]

Hello! I'm a new VBA programmer, currently working on a macro that takes each value from a specific column in one sheet, searches for that value in another sheet, copies the columns next to it, and pastes them back in the original sheet. So far, I have the code for (what I presume) will copy the first value and switch sheets. I have additional code for the searching and copying part but that doesnt seem to be functioning properly (I'll specify it to search in column G and it will search in column H for example) and it will not search the entire list, only a portion. I figured it better to start from scratch at this point. Does anyone have any ideas, pointers, or help they could provide on how to structure this program? I am at a loss. Thank you!

[jolivanes]

I am sorry but I don't quite get what you mean by "copies the columns next to it"
Do you mean cells to right or left?
Same goes for "pastes them back in the original sheet". Were they cut before?
Recently there was a thread where the OP wanted to be able to select certain columns in 2 sheets to compare and copy the found duplicates to a third sheet.
Is that similar to what you have in mind or am I way off track here.
If it is, have a play with the attached and, if possible, let us know if it is close at all.

[saupton]

Example1.jpgExample2.jpgFinalExample.jpg

Hopefully this example will clarify! The first image represents the first sheet of information that I have, the second image represents the second sheet, then you copy the values to the right of the name and paste them all back in the original sheet, represented by the final image. Thanks!

[jolivanes]

Nice pictures.
I think if you want people to help you, you should attach a workbook they can work with so they don't have to use their precious time to make one up.

[saupton]

TestWorkbook.xlsx

Here is an attachment! The final version is in sheet 3. Also, here is the code that I had previously:

Sub LookupAndPaste()
      Dim x As Long
      Dim fnd As String
      Dim NumRows As Long
      Dim cell As Range
      Dim copy As Range
      
      NumRows = Range("C2", Range("C2").End(xlDown)).Rows.Count
      Range("C2").Select
      For x = 1 To NumRows
        ActiveCell.Offset(1, 0).Select
        fnd = CStr(Selection)
        ActiveWorkbook.Sheets(2).Activate


        Do Until cell Is Nothing
            Columns("G:G").Select
            Set cell = Selection.Find(what:=fnd, after:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=True, SearchFormat:=False)


            If cell Is Nothing Then
                'do something
            Else
                Set copy = cell.Select


            End If
        Loop
        ActiveWorkbook.Sheets(1).Activate
        Next
End Sub

Thanks!!!

[apo]

Hi..

It's waay late here (2.30 am).. but a quick look suggests (in pseudo code)..

You got 2 areas on sheet 1.. iterate through each areas values and autofilter Sheet 2 by each of those values and whack the required values into sheet 3..

Will try to get time tomorrow to turn that into code..

[Bob Phillips]

Public Sub Reformat()
Dim wsLook As Worksheet
Dim cellFind As Range
Dim firstFound As String
Dim rowLast As Long
Dim rowFirst As Long
Dim rowNext As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wsLook = Worksheets("Sheet2")
    
    With Worksheets("Sheet1")
    
        rowLast = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = rowLast To 2 Step -1
        
            If .Cells(i, "B").Value <> "" Then
            
                Set cellFind = Nothing
                On Error Resume Next
                Set cellFind = wsLook.Columns(1).Find(Cells(i, "B").Value, after:=wsLook.Range("A1"))
                On Error GoTo 0
                If Not cellFind Is Nothing Then
                
                    firstFound = cellFind.Address
                    rowNext = 0
                    Do
                    
                        If rowNext > 0 Then Rows(i + rowNext).Insert
                        .Cells(i + rowNext, "D").Value = cellFind.Offset(0, 1).Value
                        .Cells(i + rowNext, "E").Value = cellFind.Offset(0, 2).Value
                        Set cellFind = wsLook.Columns(1).FindNext(cellFind)
                        rowNext = rowNext + 1
                    Loop Until cellFind Is Nothing Or cellFind.Address = firstFound
                End If
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

[saupton]

Wow! That worked absolutely flawlessly!!! Thank you all so much!

[saupton]

Worked (seemingly) flawlessly . I was editing the columns to work with a different sheet and I kept getting a "Subscript out of Range" error. So then I reverted it back to the original to test if it would even get a portion of the values that I needed and it gave me the same error. It worked perfectly on the sample file which is amazing! But would anyone be able to explain why it would give me that error on a different file?

[jolivanes]

That is usually a worksheet name that does not exist.
Could be a space before, in the "middle" or at the end also.