Copy columns based on header and array

ijhoeq

New Member
Joined
Jun 20, 2018
Messages
46
Hello,

I have data in Sheet1 that I'd like to copy into Sheet2 based on the header. I'd like to create some kind of text array that I can update in the code to include new columns if they become relevant. I'd like the relevant headers array to be something like

sWords = {"Date", "Qty", "Method"}.

Then I can add new words if I need to (Example: sWords = {"Date", "Qty", "Method", "Quality"}).

I would like the words in the sWords array to be the search criteria for copy and paste. The words could be searched for in Sheet1 Row 1. I'm sure there is a way to do this with a For Loop or something but I am new to VBA.

In Sheet1, I have the data below.

ABCDE
1Date
QtyCompleteMethodQuality
21/5/1825Yes1High
33/10/1910N2Medium

<tbody>
</tbody>

I'd like to be able to copy the headers in the sWord array and paste it into Sheet2.

For example, in the code, if I set sWord = {"Qty", "Method"}

I'd like Sheet2 to display the table below

AB
1Qty
Method
2251
3102

<tbody>
</tbody>

I hope I explained this well enough. I'd appreciate any help! Thanks!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,440
Office Version
365
Platform
Windows
How about

Rich (BB code):
Sub ijhoeq()
   Dim Ary As Variant
   Dim i As Long
   Dim Fnd As Range
   
   Ary = Array("Date", "Qty", "Method")
   With Sheets("Sheet1")
      For i = 0 To UBound(Ary)
         Set Fnd = .Range("1:1").Find(Ary(i), , , xlWhole, , , False, , False)
         If Not Fnd Is Nothing Then
            Fnd.EntireColumn.Copy Sheets("Sheet2").Cells(1, i + 1)
         End If
      Next i
   End With
End Sub
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,365
Office Version
365
Platform
Windows
Try this.
Code:
Dim sWords As Variant
Dim Res As Variant
Dim idx As Long
Dim idxCol As Long
Dim cnt As Long

    sWords = Array("Date", "Qty", "Method")
    
    With Sheets("Sheet1")
        Res = Application.Match(sWords, .Rows(1), 0)
        
        For idx = LBound(Res) To UBound(Res)
            If Not IsError(Res(idx)) Then
                cnt = cnt + 1
                idxCol = Res(idx)
                .Columns(idxCol).Copy Sheets("Sheet2").Columns(cnt)
            End If
        Next idx
    End With
 

ijhoeq

New Member
Joined
Jun 20, 2018
Messages
46
Thanks for the help! I went with Fluff's method. I just have one more issue... The data starts on row 3 so I adjusted the code and it works great but it pastes into sheet2 on row 3. Could you tell me how to paste it into row 1 on sheet2?

Thanks!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,440
Office Version
365
Platform
Windows
What is your adjusted code?
 

ijhoeq

New Member
Joined
Jun 20, 2018
Messages
46
Code:
    Dim Ary As Variant
    Dim i As Long
    Dim Fnd As Range
    
    ' Ary is the array that contains all words to search for and copy
    Ary = Array("JC", "Event Date", "MC", "Removed Part", "Installed Part", _
                "Production Number", "Number", "Score", "Board Score", _
                "TC", "AT", "WD", "MAL", "AAA Mode", "Failure", "Maintenance")
    With Sheets("Search Results")
        For i = 0 To UBound(Ary)
            Set Fnd = .Range("3:3").Find(Ary(i), , , xlWhole, , , False, , False)
            If Not Fnd Is Nothing Then
                Fnd.EntireColumn.Copy Sheets("Filtered Data").Cells(1, i + 1)
            End If
        Next i
    End With
Also, is there any way to copy the data to the last row instead of the entire column? I have a lot of data and I believe it is running very slow since it is copying the entire column.

Thanks Fluff!!
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,440
Office Version
365
Platform
Windows
How about
Rich (BB code):
Sub ijhoeq()
    Dim Ary As Variant
    Dim i As Long
    Dim Fnd As Range
    
    ' Ary is the array that contains all words to search for and copy
    Ary = Array("JC", "Event Date", "MC", "Removed Part", "Installed Part", _
                "Production Number", "Number", "Score", "Board Score", _
                "TC", "AT", "WD", "MAL", "AAA Mode", "Failure", "Maintenance")
    With Sheets("Search Results")
        For i = 0 To UBound(Ary)
            Set Fnd = .Range("3:3").Find(Ary(i), , , xlWhole, , , False, , False)
            If Not Fnd Is Nothing Then
                .Range(Fnd, .Cells(Rows.Count, Fnd.Column).End(xlUp)).Copy Sheets("Filtered Data").Cells(1, i + 1)
            End If
        Next i
    End With
End Sub
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,440
Office Version
365
Platform
Windows
Glad to help & thanks for the feedback
 

Forum statistics

Threads
1,082,607
Messages
5,366,593
Members
400,905
Latest member
xcelstudent

Some videos you may like

This Week's Hot Topics

Top