Solved

FInd and Paste

Posted on 2011-09-25
2
137 Views
Last Modified: 2012-06-21
Hello,

Trying to build a macro in workbook "Overall" thta will do the following.

1. Open workbook "Data1", which is located in C:/user1/Data.xlsx
2. Copy the data in sheet "In-Outbound" from the range of A2:E to where the value of CALL is located in Column A For example if the word CALL is in A 18, then copy A2:E18.
3. Paste that value in workbook Overall.Sheet "In-Outbound" on the next empty row after the cell that contains Outbound.  For example if the work Outbound is in cell A1, then paste in cell A2.
0
Comment
Question by:sandramac
2 Comments
 
LVL 15

Expert Comment

by:Eyal
ID: 36596995
why you don't record a macro that is doing import and see what you get?
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 36597389
>> Open workbook "Data1", which is located in C:/user1/Data.xlsx

I'm assuming the name of the workbook is Data.xlsx and not "Data1", per the below line in the code (which you can change):

fName = "c:\users1\data.xlsx" 'change your filename here - is it Data.xlsx or Data1.xlsx????

Both the source workbook, "Data.xlsx" and destination workbook "Overall.xls" have a sheet tab named, "In-Outbound", based on your description

>>Paste that value in workbook Overall.Sheet "In-Outbound" on the next empty row after the cell that contains Outbound.  For example if the work Outbound is in cell A1, then paste in cell A2.

Taking you literally - "next empty row" as opposed to "next row following" the word Outbound in column A.  So, if you import more than once, the NEXT empty row at the bottom of the dataset, following Outbound, would get the data.  make sense :)

Here's the code:

Sub overall()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim srcWkb As Workbook
Dim srcWks As Worksheet
Dim srcRng As Range
Dim fName As String
Dim fSrcRange As Range, fRange As Range

    'fName = "c:\users1\data.xlsx" 'change your filename here - is it Data.xlsx or Data1.xlsx????
    fName = ActiveWorkbook.Path & "\data.xlsx"
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("In-Outbound")
    
    'find Outbound in the destination workbook (ThisWorkbook)
    Set fRange = wks.Range("A:A").Find(what:="Outbound", LookIn:=xlFormulas, lookat:=xlWhole) 'searches for whole word "Outbound"
    
    If fRange Is Nothing Then
        MsgBox "Could not find 'OutBound' in this workbook's sheet Overall.Sheet, Column A - please check spelling, etc.", vbCritical, "Aborting..."
    Else
                
        'Open the Source workbook
        On Error GoTo errHandler
        Set srcWkb = Workbooks.Open(Filename:=fName, UpdateLinks:=2, ReadOnly:=True)
        On Error GoTo 0
        
        Set srcWks = srcWkb.Sheets("In-Outbound")
        
        'find CALL in the source workbook
        Set fSrcRange = srcWks.Range("A:A").Find(what:="CALL", LookIn:=xlFormulas, lookat:=xlWhole) 'looks for whole word "CALL"
        
        If fSrcRange Is Nothing Then
            MsgBox "Could not find 'CALL' in this workbook's sheet Overall.Sheet, Column A - please check spelling, etc.", vbCritical, "Aborting..."
        Else
        
            'copy A2:E lastrow indicated by CALL in column A
            Set srcRng = srcWks.Range("A2:E" & fSrcRange.Row)
            
            'paste to column A lastrow indicated by Outbound, the next empty row following "Outbound"
                    
            Set rng = wks.Range("A" & fRange.Row).End(xlDown)
            If rng.Row = wks.Rows.Count Then 'hit bottom, so "repair range address
                Set rng = wks.Range("A" & fRange.Row).Offset(1, 0) 'use the row following Outbound, instead, as it is really the next empty row
            Else
                Set rng = rng.Offset(1, 0) 'the row following the End(xlDown) is the empty row, in this case
            End If
            
            'now do the actual copy/paste
            srcRng.Copy
            rng.PasteSpecial Paste:=xlValues
            Application.CutCopyMode = False
        End If
        srcWkb.Close savechanges:=False 'clean up
    End If
    
cleanUp:

    Exit Sub
    
errHandler:
    MsgBox "for some reason, the file " & fName & " was unable to open, successfully", vbCritical, "Aborting!"
    
End Sub

Open in new window


There's a bit of error checking - letting you know it didn't find Outbound, or CALL, and also that it couldn't open the file data.xlsx (e.g., file doesn't exist).  If you get an error on the find on Outbound or the find on CALL, try to ensure there are no extra spaces or special cells in the text where Outbound or CALL exist.  Let me know if you have any issues.

See attached workbooks, and test file demonstrating everything works.

Enjoy!

Dave

 
Overall-r1.xlsm
Data.xlsx
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Sparklines have been introduced with Excel 2010 and are a useful tool for creating small in-cell charts, used for example in dashboards. Excel 2010 offers three different types of Sparklines: Line, Column and Win/Loss. What it does not offer is a…
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

910 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

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now