Results 1 to 6 of 6
  1. #1
    Join Date
    Mar 2009
    Posts
    2

    Unanswered: Find, Select, Copy And Paste Macro - Urgent

    Hi,

    I'm a nit of a newbie to VB, I have the basics but I am stuck with a problem!

    I have a list of names in a sheet that I want to search for in another sheet then highlight that row and copy it back into the original sheet next to the cell with the name in it.

    So in sheet1 I have cell A4 = "ABC" and I want to search in sheet2 for ABC in Column B. When the row with "ABC" is found I want to copy the row of data after the name - so Column C to column S and then paste it back into sheet1 in cell A5 (next to the original name in cell A4).

    There are a list of names in cells A4:33 so I want this process to repeat and find all of the names and the relevant data until it reaches the end of the list.

    Please help,

    Thanks,

    Chris

  2. #2
    Join Date
    Mar 2009
    Location
    Worthing, UK
    Posts
    16

    Smile

    Hi

    Please find code below.. I hope it will work.. I have double checked and worked for me. I have also attached the workbook for you.

    Please let me know if it works.




    Code:
    Sub FindSelectCopyPaste()
    
    'By Muhammad Anisur Rahman
    'Date: 10/03/2009
    'Find Select- Copy and Paste Row from Sheet2 to Sheet 1
    
    
    Dim r As Long
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim strLookup As String
    
    
    
    Set ws1 = Worksheets("Sheet1")
    
    Set ws2 = Worksheets("Sheet2")
    
    'Find LastRow for Sheet1
    LastRow1 = ws1.Cells(65536, 1).End(xlUp).Row
    
    
    'Find LastRow for Sheet2
    LastRow2 = ws2.Cells(65536, 1).End(xlUp).Row
    
    
    ws2.Select 'select sheet2
    
    
    
    Set rngLookup = Range("B1", Cells(LastRow2, 2))
    
    
     For i = 4 To LastRow1 'LastRow of Sheet2
     
                strLookup = ws1.Cells(i, 1) 'There are a list of names in cells A4:A33... A(n) or more
    
    
                r = Application.WorksheetFunction.Match(strLookup, rngLookup, 0) 'Find Row number of Sheet2 as per above criteria
    
                  
                    With ws2
                    
                    'Copy the Row Range C(r):S(r) [r is a row number]
                    'Paste into next column of criteria [Next to "ABC"] in sheet1,
                    .Range(.Cells(r, 3), .Cells(r, 19)).Copy ws1.Cells(i, 2)
                    
                    End With
                    
    
    
    Next i
    
    
    ws1.Select 'select Sheet1
    
    
    End Sub

  3. #3
    Join Date
    Mar 2009
    Posts
    2
    Thanks I will give it a go and let you know!

    C

  4. #4
    Join Date
    Feb 2009
    Posts
    6
    You can achieve this task using Macro as follows
    1. Right click on the toolbar>from the popup select control box
    2. from the control box that appears on the sheet, draw a command button on your sheet
    3. double click the command button to open the code window and paste following codes
    Code:
    Private Sub CommandButton1_Click()
        Dim row As Integer, col As Integer
        row = 4
        col = 1
        
        For row = 4 To 33
            findMatch Sheet1.Cells(row, col).Value, row
        Next
    End Sub
    
    Private Sub findMatch(str As String, i As Integer)
        Dim row As Integer, col As Integer
        row = 1
        col = 2
        
        While Sheet2.Cells(row, col).Value <> ""
            If str = Sheet2.Cells(row, col).Value Then
                For col = 3 To 19
                    Sheet1.Cells(i, col).Value = Sheet2.Cells(row, col).Value
                Next
                
            End If
            row = row + 1
        Wend
        
    End Sub
    Now execute the code and check the result

  5. #5
    Join Date
    Mar 2009
    Location
    Worthing, UK
    Posts
    16
    I gave the code with attachment... did u read or review my code/attachment..

    cheers

    Quote Originally Posted by Chris Bode
    You can achieve this task using Macro as follows
    1. Right click on the toolbar>from the popup select control box
    2. from the control box that appears on the sheet, draw a command button on your sheet
    3. double click the command button to open the code window and paste following codes
    Code:
    Private Sub CommandButton1_Click()
        Dim row As Integer, col As Integer
        row = 4
        col = 1
        
        For row = 4 To 33
            findMatch Sheet1.Cells(row, col).Value, row
        Next
    End Sub
    
    Private Sub findMatch(str As String, i As Integer)
        Dim row As Integer, col As Integer
        row = 1
        col = 2
        
        While Sheet2.Cells(row, col).Value <> ""
            If str = Sheet2.Cells(row, col).Value Then
                For col = 3 To 19
                    Sheet1.Cells(i, col).Value = Sheet2.Cells(row, col).Value
                Next
                
            End If
            row = row + 1
        Wend
        
    End Sub
    Now execute the code and check the result

  6. #6
    Join Date
    Mar 2013
    Posts
    2

    URGENT - Macro Find, select, copy and paste

    I have a VERY similar problem. I have Sheet1 with Column A being a list of all US ZipCodes.

    Sheet2 has Column A listing out only the zipcodes where we have sales and Column B has the amount of sales in that zip code.

    Ideally, here's what I want it to do:
    I want it to select A2 on Sheet1
    Search for that term on Sheet2
    If it doesn't exist on Sheet2, place a "0" in B2, then automatically move on to A3 and continue the process
    If it does exist in Column A on Sheet 2 - select the cell to the right of the result (Column B)
    Then paste that cell's contents in B2 on Sheet 1
    Then continue until ALL of column A on Sheet1 has been searched for on Sheet2.


    I have tried tons of macros, but they don't seem to work because not all of the zip codes in Column A Sheet1 exist in Sheet2...

    Here's one the one I've been using... it only works for about 5 lines before it comes up with an error... ANY HELP would be greatly appreciated. It's frustrating not being able to figure it out :/ I really don't want the MsgBox to pop up at all...



    Sub abc()
    '
    ' abc Macro
    '
    'Keyboard Shortcut: Ctrl+b

    Do Until IsEmpty(ActiveCell)
    Dim MyString As String
    MyString = ActiveCell
    Sheets("Sheet2").Select
    Set RangeObj = Cells.Find(What:=MyString, After:=ActiveCell, _
    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False)
    If RangeObj Is Nothing Then MsgBox "Not Found" Else: RangeObj.Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    ActiveCell.Offset(-1, -1).Select
    Loop
    End Sub

    Please let me know what I'm doing wrong

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •