Excel VBA copy paste columns using public variables as column names

I'm working on a VBA project in Excel, and I'm trying to copy columns from one sheet and paste them to another sheet. I'm using a public variable from a userform with a listbox to ask the user for the name of the column in sheet 1 which correlates with the name of the column in sheet 2. I have to use a listbox because the columns names in sheet 1 can vary slightly depending on the data the user imports.

The public variable is declared at the top of my module using:

Public PartsDeptLBValue As String

I want to copy the data from column name seleted from a sheet named "ImportData" with the data starting on row 5 to a sheet name "PAD2", Column("Parts Description") which starts on row 2.

I've got the userform working correctly, and it's storing the value the user selects in a public variable on the module called PartsDeptLBValue thanks to another expert.

EDIT: I've also tried this code, which I think get's me closer, but I'm getting an error that say's "The information cannot be pasted because the Copy area and the paste area are not the same size and shape."

Sub CopyPasteColumns()
Dim t As Range

PartsDeptUserForm.Show

'Find PartsDeptLBValue in Row 4
  With Sheets("ImportData").Rows(4)
   Set t = .Find(PartsDeptLBValue, lookat:=xlPart)
'If found, copy the column to PAD2, Column A
'If not found, present a message
     If Not t Is Nothing Then
        Columns(t.Column).EntireColumn.Copy _
           Destination:=Worksheets("PAD2").Range("A2")
       Else: MsgBox "Title Not Found"
     End If
  End With

End Sub

Open in new window

Here's the other code I tried, but I'm getting "Unable to get the Match property of the WorksheetFunction class" error:

Sub CopyPasteColumns()

Dim desc As String

PartsDeptUserForm.Show

    Sheets("ImportData").Select
    desc = WorksheetFunction.Match( PartsDeptLBValue, Rows("1:1"), 0)

         Sheets("ImportData").Columns(desc).Copy Destination:=Sheets("PAD2").Range("A2")

End Sub

Open in new window

I've uploaded the Excel file. Thanks in advance for your help!
TestBuySellTemplate.xlsm

LVL 6

prodempseyBI DirectorAsked: 2016-03-31

Who is Participating?

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get this solution by purchasing an Individual license! Start your 7-day free trial.

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.

LVL 59

Martin LissOlder than dirtCommented: 2016-03-31

Try this.

Sub CopyPasteColumns()
Dim t As Range
Dim lngRow As Long
Dim lngNR As Long

PartsDeptUserForm.Show

'Find PartsDeptLBValue in Row 4
  With Sheets("ImportData").Rows(4)
   Set t = .Find(PartsDeptLBValue, lookat:=xlPart)
'If found, copy the column to PAD2, Column A
'If not found, present a message
     If Not t Is Nothing Then
        lngNR = 2
        For lngRow = t.Row To Sheets("ImportData").UsedRange.Rows.Count
           Worksheets("PAD2").Cells(lngNR, "A") = Sheets("ImportData").Cells(lngRow, t.Column)
           lngNR = lngNR + 1
        Next
       Else: MsgBox "Title Not Found"
     End If
  End With

End Sub

Open in new window

LVL 7

DougCommented: 2016-03-31

Pro,

This part of your code looks to be the culprit:

 If Not t Is Nothing Then
        Columns(t.Column).EntireColumn.Copy _
           Destination:=Worksheets("PAD2").Range("A2")

Open in new window

Essentially you're trying to copy an entire column of cells into an area that's less than an entire column (starting at A2). No doubt that Martin's code is the solution but here is the reason that you were getting the error. Next time try just copying the range that you need (e.g., using the number of rows in UsedRange).

LVL 6

prodempseyBI DirectorAuthor Commented: 2016-04-01

Martin, I change this part of the code from a 2 to 1 so it wouldn't include the header

lngNR = 1

Open in new window

However, for some reason it's copying and pasting all but the last 3 rows. It was doing this before I changed lngNR = 1. Any idea why it would do that?

Thanks a lot for helping me with this. Also, I want to learn how you did this, can explain to me what the variable lngNR is doing?

LVL 6

prodempseyBI DirectorAuthor Commented: 2016-04-01

Also, I found another problem. The code is pasting the data to a Table on the PAD2 sheet called PAD_2. If there are any blanks before the last value in the column everything after the blank cell is pasted outside of the table. Is there any way to paste the entire column within the table if there are blanks?

LVL 59

Martin LissOlder than dirtCommented: 2016-04-01

Let me know if this helps.

Sub CopyPasteColumns()
Dim t As Range
Dim lngRow As Long
Dim lngNR As Long

PartsDeptUserForm.Show

'Find PartsDeptLBValue in Row 4
With Sheets("ImportData").Rows(4)
    Set t = .Find(PartsDeptLBValue, lookat:=xlPart)
'If found, copy the column to PAD2, Column A
'If not found, present a message
    If Not t Is Nothing Then
        ' The For/Next that follows copies the data from the ImportData
        ' sheet, line by line, to the PAD2 sheet and lngNR (the "NR" is my
        ' shorthand for "Next Row") is the row where the data is to be copied.
        ' So I set lngNR to 2 so that the copied data will copied to the
        ' PAD2 sheet starting at row 2.
        lngNR = 2
        ' In the next line I used to have "t.Row" which was the row where parts
        ' description was found and so to avoid copying the heading I could
        ' have changed that to "t.Row + 1" but since t will always be 4, I
        ' replaced "t.row" with 5.
        For lngRow = 5 To Sheets("ImportData").UsedRange.Rows.Count
           Worksheets("PAD2").Cells(lngNR, "A") = Sheets("ImportData").Cells(lngRow, t.Column)
           ' Add one to the next row so the next data will be copied below
           ' the previous one.
           lngNR = lngNR + 1
        Next
        ' This line of code resizes the table so that the upper left-hand corner is "A1"
        ' and the lower right-hand corner is the last cell in column "F".
        Worksheets("PAD2").ListObjects("PAD_2").Resize _
                           Range("$A$1:$F$" & Worksheets("PAD2").UsedRange.Rows.Count)
    ' I changed the following because using a colon to pack to separate lines
    ' of code on the same line is not good programming practice
    Else
        MsgBox "Title Not Found"
    End If
End With

End Sub

Open in new window

BTW if you are interested in learning more about good programming practices then please see my A Guide to Writing Understandable and Maintainable VBA Code article.

LVL 6

prodempseyBI DirectorAuthor Commented: 2016-04-01

Thanks Martin, it's now pasting into the entire table even if there are blanks, but it's still leaving off the last 3 rows. It doesn't matter if I add or remove rows from the source sheet before running the script, it still leaves off just the last 3 rows.

LVL 6

prodempseyBI DirectorAuthor Commented: 2016-04-01

Martin, by the way, I read your article, and I thought it was excellent. I'm printing it out and putting it into a binder next to my desk to reference on a regular basis. Thanks a ton for taking the time to put this together!!!

LVL 59

Martin LissOlder than dirtCommented: 2016-04-01

Here is improved code which get all the lines. BTW if the user doesn't select anything from the Parts Description list before clicking OK an error is generated. There are several ways to fix that.

Make the Listindex of Listbox1 = 0 when you initialize the userform. That assumes that you didn't really mean to add "........PART DESCRIPTION........." to that list.

In the initialization of the form, set PartsDeptButton.Enabled = False and only make it True when the listbox is clicked

After the user clicks OK, check to see if the ListIndex of the listbox is -1 and if it is then display an error message and get out.

PartsDeptUserForm.Show

'Find PartsDeptLBValue in Row 4
With Sheets("ImportData").Rows(4)
    Set t = .Find(PartsDeptLBValue, lookat:=xlPart)
'If found, copy the column to PAD2, Column A
'If not found, present a message
    If Not t Is Nothing Then
        ' The For/Next that follows copies the data from the ImportData
        ' sheet, line by line, to the PAD2 sheet and lngNR (the "NR" is my
        ' shorthand for "Next Row") is the row where the data is to be copied.
        ' So I set lngNR to 2 so that the copied data will copied to the
        ' PAD2 sheet starting at row 2.
        lngNR = 2
        ' This next line is pretty mysterious but what it does is this:
        ' "Cells(1, t.Column).Address" will be something like "$K$1"
        ' without the quotes, and Split divides it up into an array
        ' at the dollar signs. The array starts at zero and the (0)
        ' entry is a space because there's noything to the laft of the
        ' first dollar sign and so the (1) entry is "K" which is the column
        ' that was chosen, and that reduces to "Range(K1048576).End(xlUp).Row"
        ' which gives the last row in that column.
        lngLastRow = Sheets("Import Data").Range(Split(Cells(1, t.Column).Address, "$")(1) & "1048576").End(xlUp).Row
        
        ' In the next line I used to have "t.Row" which was the row where parts
        ' description was found and so to avoid copying the heading I could
        ' have changed that to "t.Row + 1" but since t will always be 4, I
        ' replaced "t.row" with 5.
        For lngRow = 5 To Sheets("ImportData").UsedRange.Rows.Count
           Worksheets("PAD2").Cells(lngNR, "A") = Sheets("ImportData").Cells(lngRow, t.Column)
           ' Add one to the next row so the next data will be copied below
           ' the previous one.
           lngNR = lngNR + 1
        Next
        ' This line of code resizes the table so that the upper left-hand corner is "A1"
        ' and the lower right-hand corner is the last cell in column "F".
        Worksheets("PAD2").ListObjects("PAD_2").Resize _
                           Range("$A$1:$F$" & Worksheets("PAD2").UsedRange.Rows.Count)
    ' I changed the following because using a colon to pack to separate lines
    ' of code on the same line is not good programming practice
    Else
        MsgBox "Title Not Found"
    End If
End With

End Sub

Open in new window

LVL 6

prodempseyBI DirectorAuthor Commented: 2016-04-02

Martin,
For some reason, it's still not pasting the last 3 rows into the target sheet.

I know it's finding the last row in the source sheet, row 2971. When I was debugging, I saw it find the correct number of rows in the immediate window using this code, but I don't see where in the code the lngLastRow variable is being used to run the loop until that last row is reached.

lngLastRow = Sheets("Import Data").Range(Split(Cells(1, t.Column).Address, "$")(1) & "1048576").End(xlUp).Row

Open in new window

Maybe I need to use a Do Until loop instead of a For Next loop, but I'm not sure how to do it.

Also, this is really weird. Whenever the lngRow variable reached 2969 rows in the loop, instead of running this line of code and pasting from cell A2969 on the ImportData sheet and pasting to cell 2966 on the PAD2 sheet, it exited the loop and didn't reach the last row at 2971.

Worksheets("PAD2").Cells(lngNR, "A") = Sheets("ImportData").Cells(lngRow, t.Column)

Open in new window

Please see the file attached with the updated code.
TestBuySellTemplate.xlsm

LVL 59

Martin LissOlder than dirtCommented: 2016-04-02

Sorry, I thought I had posted a workbook with code that gets it all but I guess I didn't. In any case here it is.
The PAD2 sheet shows the result of choosing "BIN".
28936719.xlsm

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

LVL 6

prodempseyBI DirectorAuthor Commented: 2016-04-03

Martin,
Thanks for helping me find an answer to my problem. I thought the way you found the last row in the selected column was brilliant. I made just one minor change to this line for the lngLastRow variable.

Because the user might be using a older version of excel, instead of using this:

lngLastRow = Sheets("ImportData").Range(Split(Cells(1, t.Column).Address, "$")(1) & "1048576").End(xlUp).Row

Open in new window

I replaced "1048576" with a variable I called lngRowVer, and I added this line

lngRowVer = Worksheets("ImportData").Rows.Count

Open in new window

For anyone else interested, here was the final accepted solution.

Sub GetPartsDept_UserForm_Value()

Dim t As Range
Dim lngRow As Long
Dim lngNR As Long
Dim lngLastRow As Long
Dim lngRowVer As Long


PartsDeptUserForm.Show



'Find PartsDeptLBValue in Row 4
With Sheets("ImportData").Rows(4)
    Set t = .Find(PartsDeptLBValue, lookat:=xlPart)
'If found, copy the column to PAD2, Column A
'If not found, present a message
    If Not t Is Nothing Then
        ' The For/Next that follows copies the data from the ImportData
        ' sheet, line by line, to the PAD2 sheet and lngNR (the "NR" is my
        ' shorthand for "Next Row") is the row where the data is to be copied.
        ' So I set lngNR to 2 so that the copied data will copied to the
        ' PAD2 sheet starting at row 2.
        lngNR = 2
        'This line verifies the total number of rows in the sheet, which will
        'be used in the lngLastRow variable
            lngRowVer = Worksheets("ImportData").Rows.Count
        ' This next line is pretty mysterious but what it does is this:
        ' "Cells(1, t.Column).Address" will be something like "$K$1"
        ' without the quotes, and Split divides it up into an array
        ' at the dollar signs. The array starts at zero and the (0)
        ' entry is a space because there's noything to the laft of the
        ' first dollar sign and so the (1) entry is "K" which is the column
        ' that was chosen, and that reduces to "Range(K1048576).End(xlUp).Row"
        ' which gives the last row in that column.
                        lngLastRow = Sheets("ImportData").Range(Split(Cells(1, t.Column).Address, "$")(1) & lngRowVer).End(xlUp).Row
        ' In the next line I used to have "t.Row" which was the row where parts
        ' description was found and so to avoid copying the heading I could
        ' have changed that to "t.Row + 1" but since t will always be 4, I
        ' replaced "t.row" with 5.
        For lngRow = 5 To lngLastRow
           Worksheets("PAD2").Cells(lngNR, "A") = Sheets("ImportData").Cells(lngRow, t.Column)
           ' Add one to the next row so the next data will be copied below
           ' the previous one.
           lngNR = lngNR + 1
        Next
        ' This line of code resizes the table so that the upper left-hand corner is "A1"
        ' and the lower right-hand corner is the last cell in column "F".
        Worksheets("PAD2").ListObjects("PAD_2").Resize _
                           Range("$A$1:$F$" & Worksheets("PAD2").UsedRange.Rows.Count)
    ' I changed the following because using a colon to pack to separate lines
    ' of code on the same line is not good programming practice
    Else
        MsgBox "Title Not Found"
    End If
End With


End Sub

Open in new window

LVL 6

prodempseyBI DirectorAuthor Commented: 2016-04-03

Thanks again Martin!

LVL 59

Martin LissOlder than dirtCommented: 2016-04-04

You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.

Marty - MVP 2009 to 2015
Experts Exchange MVE 2015
Experts-Exchange Top Expert Visual Basic Classic 2012 to 2015

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

VBA

From novice to tech pro — start learning today.

Microsoft Applications

By:

Sandra Batakis

Certification
Certification: MOS Microsoft Office Specialist - Excel 2007 Adva…

i

Members can enroll in this course at no extra cost.

188 lessons
Microsoft Applications

By:

Sandra Batakis

Certification
Certification: MOS Microsoft Office Specialist - Excel 2007 Basic

i

Members can enroll in this course at no extra cost.

239 lessons
Microsoft Applications

By:

Sandra Batakis

Certification
Certification: MOS Microsoft Office Specialist - Excel 2007 Inter…

i

Members can enroll in this course at no extra cost.

218 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2010 Adva…

i

Members can enroll in this course at no extra cost.

183 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2010 Basic

i

Members can enroll in this course at no extra cost.

264 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2010 Inter…

i

Members can enroll in this course at no extra cost.

277 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2013 Part …

i

Members can enroll in this course at no extra cost.

176 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2013 Part …

i

Members can enroll in this course at no extra cost.

146 lessons
Document Management

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2013 Part …

i

Members can enroll in this course at no extra cost.

116 lessons
Microsoft Applications

By:

Patrick Loner

Certification
Certification: MOS Microsoft Office Specialist - Excel 2016 Part …

i

Members can enroll in this course at no extra cost.

212 lessons