Program is only outputting one cell of a row, need to output entire row...

I need to figure out how to output the entire row of the matched cell. The program works it only outputs the exact matched cell. The problem is I also need the info in the cells to the left and right of the same row in the output file. Please, if possible provide an explanation so I can see what was missing. I still trying to learn. Thanks in advance.
Private Sub Exit_Click()
Me.Hide
End Sub
 
Private Sub Open_Click()
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim strPath As String, strFile1 As String, strFile2 As String
Dim wbkThis As Workbook, wbk1 As Workbook, wbk2 As Workbook
Dim wksDest As Worksheet, wksSource As Worksheet, wksCheck As Worksheet
Dim rngMatch As Range, rngCheck As Range, rngFound As Range, rngCopy As Range
 
  CommonDialog1.flags = cdlOFNExplorer Or cdlOFNLongNames
  CommonDialog1.FileName = ""
  CommonDialog1.Filter = "Excel Files (*.xls)|*.xls|"
  CommonDialog1.DialogTitle = "Browse for file"
  CommonDialog1.ShowOpen
 
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(CommonDialog1.FileName)
 
    Set wbkThis = Workbooks.Add
    Set wbk1 = xlBook
    Set wbk2 = Excel.Workbooks.Open("c:\Users\User1.xls")
   
    'Change sheet names as required
   
    ' This is the sheet to copy to
    Set wksDest = wbkThis.Sheets("Sheet1")
    ' This is the sheet in XLS1
    Set wksSource = wbk1.Sheets(1)
    Set wksCheck = wbk2.Sheets(1)
     
 
    ' Get first blank row in main workbook to copy to
    With wksDest
        Set rngCopy = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
    ' First cell to check in XLS1
    Set rngMatch = wksSource.Range("D1")
    ' Set check range to all used cells in column A of XLS2
    With wksCheck
        Set rngCheck = wksCheck.Range("a2")
        'Set rngCheck = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    ' Loop through cells in column A of XLS1 until a blank cell is encountered
    Do Until Len(rngMatch.value) = 0
        Set rngFound = rngCheck.Find(what:=rngMatch.value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFound Is Nothing Then
            ' Copy data from XLS2 to this workbook
            rngFound.Copy rngCopy
            Set rngCopy = rngCopy.Offset(1, 0)
        End If
        Set rngMatch = rngMatch.Offset(1, 0)
    Loop
    wbk1.Close False
    wbk2.Close False
    wbkThis.Save
End Sub

Open in new window

ToSearch.xls
User1.xls
guacolizardAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

irudykCommented:
Try changing line 53 of the code you posted above from
    rngFound.Copy rngCopy
to
    wksCheck.Rows(rngFound.Row).Copy rngCopy
rngFound.Row return the row number of the found cell and wksCheck.Rows(rngFound.Row).Copy will copy that entire row
0
guacolizardAuthor Commented:
Thanks, but still only getting a singe column. Any other ideas?
0
guacolizardAuthor Commented:
Okay I added your line and then swapped the source and check around. I got a little further. I just need to figure out how to make it only search the one column and stop.
 Set wksDest = wbkThis.Sheets("Sheet1")
    ' This is the sheet in XLS1
    Set wksSource = wbk2.Sheets(1)
    ' This is the sheet in XLS2 to compare against
    Set wksCheck = wbk1.Sheets(1)
 
    ' Get first blank row in main workbook to copy to
    With wksDest
        Set rngCopy = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
    ' First cell to check in XLS1
    Set rngMatch = wksSource.Range("A2")
    ' Set check range to all used cells in column A of XLS2
    With wksCheck
        Set rngCheck = wksCheck.Range("E9")
        'Set rngCheck = wksCheck.Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    ' Loop through cells in column A of XLS1 until a blank cell is encountered
    Do Until Len(rngMatch.value) = 0
        'Set rngFound = rngCheck.Find(what:=rngMatch.value, LookIn:=xlValues, lookat:=xlWhole)
        Set rngFound = rngCheck.Find(what:=rngMatch.value, LookAt:=xlWhole, LookIn:=xlValues, SearchOrder:=xlByColumns)
        If Not rngFound Is Nothing Then
            ' Copy data from XLS2 to this workbook
            wksCheck.Rows(rngFound.Row).Copy rngCopy
            Set rngCopy = rngCopy.Offset(1, 0)
        End If
        Set rngMatch = rngMatch.Offset(1, 0)

Open in new window

0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

guacolizardAuthor Commented:
Nevermind, that didn't work...at this point I am open to any suggestions. Thanks.
0
irudykCommented:
I think you're going to have to clarify things a little bit more.  Your code it copying the information from the User1.xls (which has nothing but a number value in column A) into a new workbook based upon a value search where the value is being pulled from the ToSearch.xls (column D).  Using my revided code I do get the full row being copied into the new workbook, but as I stated, since this copying is from the User1.xls which only has info in column A, there is nothing else that would show up in the new workbook.  I somehow doubt that this is what youwant to happen.
What would be helpful here is to give a specific example of exactly what you want to happen and even provide a sample file showing what output you are expecting to see.
0
guacolizardAuthor Commented:
Thanks for responding. Okay, what I would like to do is use the user1.xls file to locate the the values in the "E" column of ToSearch.xls and once they are located extract the entire row associated with that value. The output would look similar to the file below (but obviously not exact).
Book1.xls
0
irudykCommented:
Okay, your ToSearch.xls file posted has the info in column D not E...have you added an extra blank column to the ToSearch.xls file or did you need a blank column inserted in the new file the info is being copied to?
0
irudykCommented:
Well based upon the the original files posted, give the following code a try to see if it is retrieving the information you are looking for:
Private Sub Exit_Click()
Me.Hide
End Sub
 
Private Sub Open_Click()
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim strPath As String, strFile1 As String, strFile2 As String
Dim wbkThis As Workbook, wbk1 As Workbook, wbk2 As Workbook
Dim wksDest As Worksheet, wksSource As Worksheet, wksCheck As Worksheet
Dim rngMatch As Range, rngCheck As Range, rngFound As Range, rngCopy As Range
 
  CommonDialog1.flags = cdlOFNExplorer Or cdlOFNLongNames
  CommonDialog1.Filename = ""
  CommonDialog1.Filter = "Excel Files (*.xls)|*.xls|"
  CommonDialog1.DialogTitle = "Browse for file"
  CommonDialog1.ShowOpen
 
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(CommonDialog1.Filename)
 
    Set wbkThis = Workbooks.Add
    Set wbk1 = xlBook
    Set wbk2 = Excel.Workbooks.Open("c:\Users\User1.xls")
   
    'Change sheet names as required
   
    ' This is the sheet to copy to
    Set wksDest = wbkThis.Sheets("Sheet1")
    ' This is the sheet in XLS1
    Set wksSource = wbk1.Sheets(1)
    Set wksCheck = wbk2.Sheets(1)
 
    ' Get first blank row in main workbook to copy to
    With wksDest
        Set rngCopy = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
    ' column to check in wksSource
    Set rngMatch = wksSource.Range("D:D")
    ' Set check range to all used cells in column A of wksCheck
    Set rngCheck = wksCheck.Range("a2")
    ' Loop through cells in column A of wksCheck until a blank cell is encountered
    Do Until Len(rngCheck.Value) = 0
        Set rngFound = rngMatch.Find(what:=rngCheck.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFound Is Nothing Then
            ' Copy data from wksSource to wksDest
            wksSource.Rows(rngFound.Row).Copy rngCopy
            Set rngCopy = rngCopy.Offset(1, 0)
        End If
        Set rngCheck = rngCheck.Offset(1, 0)
    Loop
    wbk1.Close False
    wbk2.Close False
    wbkThis.Save
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
guacolizardAuthor Commented:
Thank you much!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.