Solved VBA macro to copy multiple columns in user defined order

March 7, 2017 at 06:08:52
Specs: Windows 64
Hi everyone,

I am asking for help since I have got stuck with my code and barely can find solution on my own even after I tried to make a Google search on my topic.

I have a huge data set which starts from A:AW and many columns down. In my work, I have to create several new tables (in new worksheets) based on user-defined-criterias. This working task I perform on a quite offen basis as soon as I receive the update on the sorting data set (the number of columns and criteria-column are always the same).

VBA task: I made a code which take a given data set into input-array and depending on user-defined-criteria finds the match and copy all rows to the right.

My personal issue:
1. I would like to pik up the concrete columns in a specific sequences: 19, 20, 18, 31, 28,41.
2. I would like my output-table to be re-sized once more so that in my new worksheet the table will start from A1:.
How can I modify my VBA-macro to reach the desired result?

Sub ComplianceTabel()
Dim lRow As Long
Dim lCol As Long
Dim lCount As Long
Dim rInputTable As Range
Dim rTarget As Range
Dim arInput()
Dim arOutput()
Dim vPattern As Variant

On Error GoTo ErrorHandle

vPattern = InputBox("Angiv complience gruppe", "Identifikator")
If Len(vPattern) = 0 Then Exit Sub

Set rInputTable = Range("A1").CurrentRegion
arInput = rInputTable.Value
Set rInputTable = Nothing
ReDim arOutput(1 To UBound(arInput), 1 To UBound(arInput, 2))

For lRow = 1 To UBound(arInput)
If arInput(lRow, 22) Like vPattern Then
lCount = lCount + 1
For lCol = 23 To UBound(arInput, 2)
'the output table should have colon-numbers in the next sequence: 19, 20, 18, 31, 28,41
arOutput(lCount, lCol) = arInput(lRow, lCol)
Next
End If
Next

If lCount = 0 Then
MsgBox "Ingen rækker opfyldte søgekriteriet."
GoTo BeforeExit
End If

Worksheets.Add
Set rTarget = Range("A1").Resize(UBound(arOutput), UBound(arOutput, 2))
rTarget.Value = arOutput

BeforeExit:
On Error Resume Next
Set rTarget = Nothing
Erase arInput
Erase arOutput

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure CopyRows"
Resume BeforeExit
End Sub




See More: VBA macro to copy multiple columns in user defined order

Report •

✔ Best Answer
March 9, 2017 at 12:22:07
OK, I'd love to help, but without your actual data - or generic, non-confidential data in the same layout - It's hard for me to follow along with what your code is trying to accomplish.

If it's possible for you to upload a "safe" (non-confidential, no personal data) copy of your workbook to zippyshare, then I would have much better idea of what is going on.

The one thing I can mention right off is that this snippet is probably not what you are looking for:

Dim myColArray As Variant
myColArray = Array(22, 19, 20, 18, 31, 28, 41)' include column 22?

For lCol = 0 To UBound(myColArray)
   rawData = Sheets(myColArray(i)).Range("A2:AW" & _
                    myColArray(i).Range("A3446").End(xlUp).Row)    ' finding data area

Let's break that down:

myColArray = Array(22, 19, 20, 18, 31, 28, 41)
defines an array that contains a series of numbers meant to reference specific Columns. 22, 19, etc.

So far, so good.

For lCol = 0 To UBound(myColArray)
loops through the Array elements, such that lCol will equal 0, then, 1 then 2, until it reaches the number of elements in the array.

Still, so far, so good.

rawData = Sheets(myColArray(i)).Range("A2:AW" & _
                    myColArray(i).Range("A3446").End(xlUp).Row)

This is where we run into problems You used myColArray(i). Note the "i". You have never set "i" equal to anything, so as far as VBA is concerned, it is always going to equal 0. Therefore, myColArray(i) will always equal 22, since that is the first (or "0") element of the myColArray array. Maybe you meant to use lCol since that is your loop variable, but I don’t think even that will help, because...

You then use myColArray(i) in Sheets(myColArray(i)). Therefore, you are asking VBA to reference Sheet(22). In fact since i will always equal 0, you are always going to reference Sheet(22). I don't know whether or not you actually have a Sheet(22) in your workbook, but even if you do, I'm pretty sure that that is not what you are trying to reference. I say that because you said you wanted to reference specific columns, not sheets.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
March 7, 2017 at 20:22:40
Please read the instructions found at the following link and then edit your post/repost your code so that it is easier for us to read. Thanks!

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
March 7, 2017 at 23:44:53

Hey again, I hope that now I have post my code in the correct way.

Sub Compl2Tabel()
Dim lRow As Long
Dim lCol As Long
Dim lCount As Long
Dim rInputTable As Range   'Inputtable
Dim rTarget As Range       'Outputtable
Dim arInput()              'Array for inputtable
Dim arOutput()             'Array for outputtable
Dim vPattern As Variant

On Error GoTo ErrorHandle

vPattern = InputBox("Angiv complience gruppe", "Identifikator")
If Len(vPattern) = 0 Then Exit Sub

Set rInputTable = Range("A1").CurrentRegion
arInput = rInputTable.Value
Set rInputTable = Nothing
ReDim arOutput(1 To UBound(arInput), 1 To UBound(arInput, 2))

For lRow = 1 To UBound(arInput)
      If arInput(lRow, 22) Like vPattern Then
      lCount = lCount + 1
      For lCol = 23 To UBound(arInput, 2)
      'the output table should have colon-numbers in next sequences: 19, 20, 18, 31, 28,41
         arOutput(lCount, lCol) = arInput(lRow, lCol)
      Next
   End If
Next

If lCount = 0 Then
   MsgBox "Ingen rækker opfyldte søgekriteriet."
   GoTo BeforeExit
End If

Worksheets.Add
Set rTarget = Range("A1").Resize(UBound(arOutput), UBound(arOutput, 2))
rTarget.Value = arOutput

BeforeExit:
On Error Resume Next
Set rTarget = Nothing
Erase arInput
Erase arOutput

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure CopyRows"
Resume BeforeExit
End Sub




Report •

#3
March 8, 2017 at 11:57:03
Thank you for reposting your code.

Without knowing how your data is laid out or being able to understand the language of your InputBox or MsgBox, I'm kind of at a loss here.

As far as outputiing specific columns in a specific order, can you just build an array of the columns numbers and then use the array elements, in the order they are in, to build the table?

Something like:

 Dim myColArray As Variant
  myColArray = Array(19, 20, 18, 31, 28, 41)
   For myCol = 0 To UBound(myColArray)
    'Do something with myColArray(myCol)
   Next

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
March 9, 2017 at 02:38:41
Hi,

My task is to defind a dinamic array from the raw data with user-defined-columns. After this, based on value in column 22 from the raw data resize the table and put it in the new worksheet of the same workbook.

The sorting data in column 22, containes tre text parameters: Compliance 1, Complience2, NonCompliance. What's why I tried to put vPattern asking the user to identify the seaching parameter. MsgBox is now changed.

After finding the match in this column, the macro has to resize the array and put it as output into a new worksheet, while the other rows have to be just copy-pasted in the given sequence, because they show product number, description, unit, amount, Price and customer. The sorting criteria hasn't to be shown in the output table.

Product number	Description	Unit	Amount	Price	Customer

The first row of the raw data contains names of the outputtable, so this has to be copy-pasted in new array. I haven't focus on this yet as I have more issues on my coding than that.

Previously, I worked with putting the data into a dynamic array making my sorting and putting the sorting data into other worksheet, so I was happy at that time. What's why I tried to change my earlier macro-code.

Now, I got stuck since I don't know how to define the array which is limited to certain columns that are not sequencing.

Since yesterday, I tried to get some ideas how I think it might work (structure of the process and tried to put it into a code, below).I believe I have to apply InStr vba function to compare strings. However, I am still struggling with choosing the required sequence and not aware of looping.

Even though, the macro doesn't work, I inserted it her with comments to help with understanding what I am trying to reach.

Sub SortingComplianceReportsTabel()

Dim lRow As Long
Dim lCol As Long
Dim vPattern As Variant
Dim rawData As Variant
Dim i As Integer
Dim outputData As Variant
Dim J As Long, U As Long, X As Integer

vPattern = InputBox("Indicate compliance group", "Indikators")
If Len(vPattern) = 0 Then Exit Sub

Dim myColArray As Variant
myColArray = Array(22, 19, 20, 18, 31, 28, 41)' include column 22?

For lCol = 0 To UBound(myColArray)
   rawData = Sheets(myColArray(i)).Range("A2:AW" & _
                    myColArray(i).Range("A3446").End(xlUp).Row)    ' finding data area
   lRow = UBound(rawData, 1)    ' number of rows
   lCol = UBound(rawData, 2)    ' number of columns
    ReDim outputData(lRow, lCol)
    For J = 2 To lRow
        If InStr(1, UCase(rawData(J, 22)), vPattern) > 0 Then
             'finding match by means of InStr function
                For X = 1 To lCol
                    outputData(U, X) = rawData(J, X) ' writing the match in array
                Next
                U = U + 1 ' new rows
            End If
        Next
        If myColArray(i) = 1 Then
            Worksheets.Add.Range("A2").Resize(lRow, lCol) = outputData
        Else
    MsgBox "No rows matching search parameter"
        End If
Next

BeforeExit:
On Error Resume Next
Set outputData = Nothing
Erase myColArray

End Sub




Report •

#5
March 9, 2017 at 12:22:07
✔ Best Answer
OK, I'd love to help, but without your actual data - or generic, non-confidential data in the same layout - It's hard for me to follow along with what your code is trying to accomplish.

If it's possible for you to upload a "safe" (non-confidential, no personal data) copy of your workbook to zippyshare, then I would have much better idea of what is going on.

The one thing I can mention right off is that this snippet is probably not what you are looking for:

Dim myColArray As Variant
myColArray = Array(22, 19, 20, 18, 31, 28, 41)' include column 22?

For lCol = 0 To UBound(myColArray)
   rawData = Sheets(myColArray(i)).Range("A2:AW" & _
                    myColArray(i).Range("A3446").End(xlUp).Row)    ' finding data area

Let's break that down:

myColArray = Array(22, 19, 20, 18, 31, 28, 41)
defines an array that contains a series of numbers meant to reference specific Columns. 22, 19, etc.

So far, so good.

For lCol = 0 To UBound(myColArray)
loops through the Array elements, such that lCol will equal 0, then, 1 then 2, until it reaches the number of elements in the array.

Still, so far, so good.

rawData = Sheets(myColArray(i)).Range("A2:AW" & _
                    myColArray(i).Range("A3446").End(xlUp).Row)

This is where we run into problems You used myColArray(i). Note the "i". You have never set "i" equal to anything, so as far as VBA is concerned, it is always going to equal 0. Therefore, myColArray(i) will always equal 22, since that is the first (or "0") element of the myColArray array. Maybe you meant to use lCol since that is your loop variable, but I don’t think even that will help, because...

You then use myColArray(i) in Sheets(myColArray(i)). Therefore, you are asking VBA to reference Sheet(22). In fact since i will always equal 0, you are always going to reference Sheet(22). I don't know whether or not you actually have a Sheet(22) in your workbook, but even if you do, I'm pretty sure that that is not what you are trying to reference. I say that because you said you wanted to reference specific columns, not sheets.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
March 10, 2017 at 09:09:21
Hey,

Thank you for your advice and clarifications.

I tried today to revert to my first macro and inserted myColArray more properly - after your explanations I understand better how it works. Still, my macro doesn't deliver that I would like.

I have just seached for the place to upload my Excel file (impersonal and clean) but not succeeded in finding this zippyshare - where it is?


Report •

#7
March 22, 2017 at 06:22:40
Sub CompliancesTabels_1_2_No()

    Dim lRow As Long, X As Long
    Dim lCol As Long
    Dim lCount As Long
    Dim rInputTable As Variant
    Dim rTarget As Range
    Dim arInput()
    Dim arOutput()
    Dim vPattern As Variant

    ' On Error GoTo ErrorHandle

    vPattern = InputBox("Insert criteria", "Identificator")
    If Len(vPattern) = 0 Then Exit Sub

    Dim myColArray As Variant
    myColArray = Array(19, 20, 18, 31, 28, 41)

    rInputTable = Sheets("test").Range("A1").CurrentRegion
    ReDim arOutput(1 To UBound(rInputTable), 1 To UBound(myColArray))
    X = 1
    For lRow = 1 To UBound(rInputTable)
        If (rInputTable(lRow, 22) = vPattern) Or lRow = 1 Then    ' lRow = 1 overskrifter

            For lCol = 1 To UBound(myColArray)
                arOutput(X, lCol) = rInputTable(lRow, myColArray(lCol))

            Next
            X = X + 1
        End If
    Next


    If X = 1 Then
        MsgBox "No matches are found."
        GoTo BeforeExit
    End If

    Worksheets.Add.Name = vPattern
    Range("A1").Resize(UBound(arOutput), UBound(arOutput, 2)) = arOutput

BeforeExit:
    On Error Resume Next
    Erase arInput
    Erase arOutput

    Exit Sub
ErrorHandle:
    MsgBox Err.Description & " Procedure CopyRows"
    Resume BeforeExit
End Sub


Report •

#8
March 22, 2017 at 09:50:56
re: "I have just seached for the place to upload my Excel file (impersonal and clean) but not succeeded in finding this zippyshare - where it is?"

zippyshare.com

However, I will not have access to Excel for at least 5 days, so don't expect any prompt action. Maybe someone else will step up in the meantime.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#9
March 22, 2017 at 12:11:55
Thank you, I have found solution (which I posted under #7). You have been helping a lot by explaining things to me - arrays is totally new area for me, yet, I've encountered huge data to sort out and in this case arrays are extremely useful due to time of proceeding. Currently, I am focusing on other "Sorting" and posted my new question today.

Report •

Ask Question