Consulting

Results 1 to 6 of 6

Thread: How to search on two or more sheets?

  1. #1

    How to search on two or more sheets?

    This macro search on sheet1 and range ("A10:A250"). I need to change macro in the way so macro can search on sheet 2 and range ("B5:b25") and Sheet3 and range ("a1:a32").


    Private Sub CommandButton1_Click()
    Dim rFound As Range
    Dim sFirstAdd As String
    Dim rLook As Range
    Dim rValue As Range
    Dim k As Range
    Set rValue = Sheet1.Range("A5")
    Set rLook = Sheet1.Range("A10:A250")
    Set rFound = rLook.Find(rValue.Value, , , xlWhole)
    If rFound > 0 Then
    rFound.EntireRow.Copy


    With Worksheets("Sheet2").Range("1:2")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteComments
    '.Cells(RW - 1, 1) = rFound.Value
    '.Cells(RW, 2) = rFound.Offset(0, 2).Value
    '.Cells(RW, 3) = rFound.Offset(0, 5).Value
    '.Cells(RW + 1, 1) = rFound.Offset(1, 0).Value
    End With
    End If
    If rFound > 0 Then
    rFound.Offset(1, 0).EntireRow.Copy


    With Worksheets("Sheet2").Range("2:2")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteComments

    End With
    End If

    End Sub

  2. #2
    VBAX Master XLGibbs's Avatar
    Joined
    Jan 2006
    Location
    state of confusion, but vacation in denial
    Posts
    1,315
    Location
    Not 100% sure I follow your issue or what the desired result is, but maybe this will give you some ideas.

    [VBA]
    Private Sub foo()
    Dim rFound As Range
    Dim rLook As Range
    rValue As String
    Dim rDest As Range
    rValue = Sheet1.Range("A5")
    Set rLook = Sheet1.Range("A10:A250")
    Set rDest = Worksheets("Sheet2").Range("A1")


    Set rFound = rLook.Find(rValue, , , xlWhole)
    If Not rFound Is Nothing Then
    rFound.EntireRow.Copy
    rDest.PasteSpecial xlValues
    rDest.PasteSpecial xlPasteComments
    Set rDest = rDest.Offset(1, 0) 'reset the dest range to 1 row below
    End If
    'reset the range and do again
    Set rLook = Worksheets("Sheet2").Range("B5:b25")
    Set rFound = rLook.Find(rValue, , , xlWhole)
    If Not rFound Is Nothing Then
    rFound.EntireRow.Copy
    rDest.PasteSpecial xlValues
    rDest.PasteSpecial xlPasteComments
    Set rDest = rDest.Offset(1, 0)
    End If

    Set rLook = Worksheets("Sheet3").Range("a1:a32")
    Set rFound = rLook.Find(rValue, , , xlWhole)
    If Not rFound Is Nothing Then
    rFound.EntireRow.Copy
    rDest.PasteSpecial xlValues
    rDest.PasteSpecial xlPasteComments
    Set rDest = rDest.Offset(1, 0)
    End If


    End Sub


    [/VBA]
    If you have posted the same question at multiple forums, please read this IMPORTANT INFO.

    Please use the thread tools to mark your thread Solved


    Please review the Knowledge Base
    for samples and solutions , or to submit your own!




  3. #3
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,140
    Location
    [vba]

    Private Sub CommandButton1_Click()
    Call UpdateData(rLook:=Sheet1.Range("A10:A250"), rValue:=Sheet1.Range("A5").Value)
    Call UpdateData(rLook:=Sheet2.Range("B2:B25"), rValue:=Sheet1.Range("A5").Value)
    Call UpdateData(rLook:=Sheet3.Range("A1:A32"), rValue:=Sheet1.Range("A5").Value)
    End Sub

    Private Sub UpdateData(rLook As Range, rValue As Range)
    Dim rFound As Range
    Dim sFirstAdd As String
    Dim rLook As Range
    Dim k As Range

    Set rFound = rLook.Find(rValue.Value, , , xlWhole)
    If rFound > 0 Then
    rFound.EntireRow.Copy

    With Worksheets("Sheet2").Range("1:2")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteComments

    End With
    End If
    If rFound > 0 Then
    rFound.Offset(1, 0).EntireRow.Copy

    With Worksheets("Sheet2").Range("2:2")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteComments

    End With
    End If

    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  4. #4

    Thanks!

    It works!Thanks very much!
    But I need one more thing. This makro copy entire row but I don't need to copy value from column A.

  5. #5
    VBAX Master XLGibbs's Avatar
    Joined
    Jan 2006
    Location
    state of confusion, but vacation in denial
    Posts
    1,315
    Location
    Specify the range to copy... rFound.Offset(,1).Resize(1,20).Copy

    Would , for example, move one column to the right of the rFound cell, then resize to 1 row and 20 columns from there to copy that data to the location.
    If you have posted the same question at multiple forums, please read this IMPORTANT INFO.

    Please use the thread tools to mark your thread Solved


    Please review the Knowledge Base
    for samples and solutions , or to submit your own!




  6. #6
    It works!!!!
    XL gibbs and xld thanks very much!

Posting Permissions

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