Solved

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

Posted on 2008-10-11
9
244 Views
Last Modified: 2011-10-19
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
0
Comment
Question by:guacolizard
  • 5
  • 4
9 Comments
 
LVL 23

Expert Comment

by:irudyk
ID: 22696113
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
 

Author Comment

by:guacolizard
ID: 22696477
Thanks, but still only getting a singe column. Any other ideas?
0
 

Author Comment

by:guacolizard
ID: 22696562
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
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 

Author Comment

by:guacolizard
ID: 22697905
Nevermind, that didn't work...at this point I am open to any suggestions. Thanks.
0
 
LVL 23

Expert Comment

by:irudyk
ID: 22698484
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
 

Author Comment

by:guacolizard
ID: 22698899
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
 
LVL 23

Expert Comment

by:irudyk
ID: 22698935
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
 
LVL 23

Accepted Solution

by:
irudyk earned 500 total points
ID: 22699049
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
 

Author Closing Comment

by:guacolizard
ID: 31505542
Thank you much!
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

861 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question