Appending data in Excel

Hi!

I need to paste data from a spreadsheet and have it append onto the bottom of previously added data. At the moment I have a macro which allows me to map the columns from one spreadsheet to the columns in another but the data pastes over already copied data. Any help would be appreciated. I have attached the spreadsheet with the macro and the spreadsheet with the data I want to transfer.

Please let me know if you have any questions.

Thanks in advance.
WLK-Raw.xlsm
Book1345.xls
Lozza64Asked:
Who is Participating?
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.

 
dlmilleCommented:
Please allow me to provide some constructive input, based on what you poasted.   Not sure it works properly, as is.  I'm able to get things setup from workbook_open, but changing the target workbook gives errors when I try to import.  Not important on my side, just letting you know.

Your GetNewFile routine doesn't close the existing hidden instance of excel (or at least the file that may be open, there), nor does it open that new target file.  You may want to address this code.

Also, the code assumes there's data in row 2 at least, because if not, the first row to paste values would be the bottom of the spreadsheet.  I modified the code to look from the bottom of the worksheet, up, then added 2 rows (creates one blank line before inserting data)

And, in both Excel 2007 and 2010, it can be problematic to select an entire column, then paste from a row other than row 1 in a new worksheet.  I realize the test book is Excel 2003 or prior, so rowcount is < 65536, just wanted to point that out.  Rather than copy/paste, I pulled the data into a variant array, then pasted those outputs to the column of choice.

Finally, at least as I run it - doing your steps manually, copying data with copy/paste from one workbook to another with different Excel instances voids the ability to copy/paste values - there are different options.

All these comments allow those of us trying to help you have problems even reproducing what you're getting.  I'm just pointing these things out as you may not be aware (or my setup is the exception to the rule).  Sorry for the disertation.  Please allow me to proceed with the solution - that works with my setup - which will hopefully work on yours!

------------------------------------

Ok - the way to keep from overwriting your data? (if all else in your mind is nonsense, as the code works for you, then the following is directly tied to your question of how to avoid overwriting existing data):

 
If TargetCol <> 0 Then
        'DestRow = WS.Columns(TargetCol).End(xlDown).Row + 2
        DestRow = WS.Cells(WS.Rows.Count, TargetCol).End(xlUp).Row + 2 'desire to skip a row between data imports?
        
        'Define copy range for import
        Set topRng = wsOrigin.Columns(Col.Column).Cells(2, 1) 'don't get the top row, as it gets deleted as the last step - don't need to do the delete if we don't do the copy!
        Set botRng = wsOrigin.Cells(wsOrigin.Rows.Count, Col.Column).End(xlUp)
        Set copyRange = wsOrigin.Range(topRng, botRng)
        copyVals = Application.Transpose(copyRange.Value)
        'wsOrigin.Columns(Col.Column).EntireColumn.Copy
        'WS.Cells(DestRow, TargetCol).Select
        'ActiveCell.PasteSpecial Paste:=xlPasteValues
        WS.Cells(DestRow, TargetCol).Resize(UBound(copyVals), 1).Value = Application.Transpose(copyVals)
        'WS.Cells(DestRow, TargetCol).Delete Shift:=xlShiftUp
    End If

Open in new window


Please see functioning workbook with the changes mentioned to successfully import data without overwriting.  Again, note, the code doesn't close out any files that have been opened, if you're opening files in series...

Please advise if I can be of more assistance.

Enjoy!

Dave
WLK-Raw-r1.xlsm
0
 
Lozza64Author Commented:
Hi Dave!

Thanks for your feedback on the code. I didnt realise these issues were apparent so I will be able to address them now thankyou!

The code for appending data works great! How do I remove the option to have one line in between imports? Ive tried to tweak it a few ways and keep getting errors (which may be a problem with the code Ive written, not yours!)

Thanks in advance :)
0
 
dlmilleCommented:
Just change this line in the IF block:

    If TargetCol <> 0 Then
        'DestRow = WS.Columns(TargetCol).End(xlDown).Row + 2
       DestRow = WS.Cells(WS.Rows.Count, TargetCol).End(xlUp).Row + 1 '+2 would to skip a row between data imports        
        'Define copy range for import
        Set topRng = wsOrigin.Columns(Col.Column).Cells(2, 1) 'don't get the top row, as it gets deleted as the last step - don't need to do the delete if we don't do the copy!
        Set botRng = wsOrigin.Cells(wsOrigin.Rows.Count, Col.Column).End(xlUp)
        Set copyRange = wsOrigin.Range(topRng, botRng)
        copyVals = Application.Transpose(copyRange.Value)
        'wsOrigin.Columns(Col.Column).EntireColumn.Copy
        'WS.Cells(DestRow, TargetCol).Select
        'ActiveCell.PasteSpecial Paste:=xlPasteValues
        WS.Cells(DestRow, TargetCol).Resize(UBound(copyVals), 1).Value = Application.Transpose(copyVals)
        'WS.Cells(DestRow, TargetCol).Delete Shift:=xlShiftUp
    End If

See attached.

Good luck!

Dave
WLK-Raw-r2.xlsm
0
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.

 
Lozza64Author Commented:
Hi Dave,

I tried changing that line before and it does remove the row between data imports but the first two lines of the data import is cut off?

Thanks! Lauren
0
 
dlmilleCommented:
Strange, when I ran it (changing the +2 to +1) it imported all the data, with no lines skipped...

The datafile you submitted has 4 rows of data.  I imported the first and second "column" into column 109.  I got 8 rows of output.

Here's my file after doing the import and halting the process after the first two.

Are you not getting similar results?  Please try first with the datafile you submitted (as opposed to a potentially different formatted datafile - just in case :)

Dave
WLK-Raw-r2.xlsm
0
 
Lozza64Author Commented:
Yes when the data goes into columns with info in all three (or two) rows for the title it works perfectly but I dont think it likes the merged cells e.g. at the beginning (columns 1-5). Is there anyway to get around this or is the best way to deal with it to just unmerge the cells? Its not a big deal if I have to unmerge them...it just looks better formatted that way!

Thanks Dave!
0
 
dlmilleCommented:
Sorry it took me a while to get back to this.

Your column headers are on row 1.  If you were to make them on row 3, then the .End(xlUp) would find that row (rather than row 1)...

We can use any cell's mergedarea property to get to the range of any single cell or merged areas, then we can use the .rows.count property (e.g., selection.mergedarea.rows.count) to get the height of the merged area.  Taking that number and adding to the End(xlup).Row, and subtracting 1, we get the last row (whew.  This is a good one to understand!).  I tested on several columns in column 1-5 range and around 109.  Seems to be working A-OK!

Here's your revised subroutine:
 
Sub ImportData()
Dim WS As Worksheet
Dim DestRow, TargetCol As Long
Dim Col, C, X
Dim copyVals As Variant, topRng As Range, botRng As Range, copyRange As Range
Dim tmpRng As Range

Set WS = ActiveSheet

For Each Col In wsOrigin.UsedRange.Columns
    'Locate the Column in the Activesheet
    Set C = WS.Range("1:1").Find(wsOrigin.Cells(Col.Row, Col.Column), LookIn:=xlValues, lookat:=xlPart)
    If Not C Is Nothing Then
        'Col Was found
        X = MsgBox("Found in Origin File:" & Chr(9) & "Col " & Col.Column & " - " & wsOrigin.Cells(Col.Row, Col.Column) & Chr(10) _
            & "Will add to existing:" & Chr(9) & "Col " & C.Column & " - " & C & Chr(10) & Chr(10) _
            & "OK to proceed ?", vbQuestion + vbYesNoCancel, "Import Columns")
        Select Case X
            Case vbYes
            TargetCol = C.Column
            Case vbCancel
                TargetCol = 0
            Case vbNo
                TargetCol = InputBox("Please choose destination Column Number for Origin: " & "Col " & wsOrigin.Cells(Col.Row, Col.Column) & " " & Col.Column)
        End Select

    Else
        'Col was not found
        TargetCol = InputBox("Please choose destination Column Number for Origin: " & "Col " & wsOrigin.Cells(Col.Row, Col.Column) & " " & Col.Column)
    End If
    
    If TargetCol <> 0 Then
        Set tmpRng = WS.Cells(WS.Rows.Count, TargetCol).End(xlUp)
        DestRow = tmpRng.Row + (tmpRng.MergeArea.Rows.Count - 1) + 1 '-1 to get to end of merged area, then + 1 for new, blank row
        
        'Define copy range for import
        Set topRng = wsOrigin.Columns(Col.Column).Cells(2, 1) 'don't get the top row, as it gets deleted as the last step - don't need to do the delete if we don't do the copy!
        Set botRng = wsOrigin.Cells(wsOrigin.Rows.Count, Col.Column).End(xlUp)
        Set copyRange = wsOrigin.Range(topRng, botRng)
        copyVals = Application.Transpose(copyRange.Value)
        WS.Cells(DestRow, TargetCol).Resize(UBound(copyVals), 1).Value = Application.Transpose(copyVals)
    End If
Next Col

WS.Range("a1").Copy
Application.CutCopyMode = False
MsgBox ("Import completed successfully for " & wsOrigin.UsedRange.Columns.Count & " Column(s)")


End Sub

Open in new window


See attached.

Enjoy!

Dave
WLK-Raw-r3.xlsm
0

Experts Exchange Solution brought to you by ConnectWise

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
 
Lozza64Author Commented:
Perfect! Thankyou Dave :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.