Excel VBA copy paste columns using public variables as column names

prodempsey
prodempsey used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Doug

Commented:
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).
prodempseyBI Director
Top Expert 2016

Author

Commented:
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?
Starting with Angular 5

Learn the essential features and functions of the popular JavaScript framework for building mobile, desktop and web applications.

Start Today!
prodempseyBI Director
Top Expert 2016

Author

Commented:
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?
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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.
prodempseyBI Director
Top Expert 2016

Author

Commented:
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.
prodempseyBI Director
Top Expert 2016

Author

Commented:
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!!!
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

prodempseyBI Director
Top Expert 2016

Author

Commented:
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
Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
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
prodempseyBI Director
Top Expert 2016

Author

Commented:
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

prodempseyBI Director
Top Expert 2016

Author

Commented:
Thanks again Martin!
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial