How to make Array work with header name having 3 words

[Gogleguy]

I need to find certain columns based on header name in 1 sheet and copy them to another. My code works for "Task Type" and "User". However it does not copy the other columns. I tried using 2 words and it worked. For ex. Instead of "User Email Address", I changed the column header and array to "User Email" and it worked. Is there a way to make it work for header with 3 words? Thanks

For Each vHeader In Array("Task Type", "User", "User Email Address", "User First Name", "User Last Name", "User Preferred Language")
Set rngFound = ws_A.Cells.Find(vHeader, , xlValues, xlWhole, 1, i)
i = i + 1
If Not rngFound Is Nothing Then
Range(rngFound, rngFound.End(xlDown)).Copy Destination:=ws_B.Cells(1, i)
End If
Next

 

[DanteAmor]

If the headers in the sheet are written the same as the ones in the array, you should have no problem with the following:

  For Each vHeader In Array("Task Type", "User", "User Email Address", "User First Name", "User Last Name", "User Preferred Language")
    Set rngFound = ws_A.Cells.Find(vHeader, , xlValues, xlWhole, , , False)
    i = i + 1
    If Not rngFound Is Nothing Then
      Range(rngFound, rngFound.End(xlDown)).Copy Destination:=ws_B.Cells(1, i)
    End If
  Next

 

[JoeMo]

Your posted code works fine for me regardless of the number of words. That's true even if I ignore the last argument in your Find statement:

Set rngFound = ws_A.Cells.Find(vHeader, , xlValues, xlWhole, 1, i)

where that argument, which is the search direction, is "i" which makes no sense since the search direction can be only xlNext - or 1, or xlPrevious - or 2.
You might try replacing the "i" with 1.

 

[Gogleguy]

Your posted code works fine for me regardless of the number of words. That's true even if I ignore the last argument in your Find statement:

Set rngFound = ws_A.Cells.Find(vHeader, , xlValues, xlWhole, 1, i)

where that argument, which is the search direction, is "i" which makes no sense since the search direction can be only xlNext - or 1, or xlPrevious - or 2.
You might try replacing the "i" with 1.

If the headers in the sheet are written the same as the ones in the array, you should have no problem with the following:

  For Each vHeader In Array("Task Type", "User", "User Email Address", "User First Name", "User Last Name", "User Preferred Language")
    Set rngFound = ws_A.Cells.Find(vHeader, , xlValues, xlWhole, , , False)
    i = i + 1
    If Not rngFound Is Nothing Then
      Range(rngFound, rngFound.End(xlDown)).Copy Destination:=ws_B.Cells(1, i)
    End If
  Next

Thank you Dante Amor and Joe. I tried both of your solutions but they give the same earlier results. It seems the headers in the raw data sheet have some formatting or line break which is not letting the array code work. Is there a way to get around this?

Below are the headers from the raw data sheet

User Email Address

User First Name

User Last Name

User Preferred Language

 

[DanteAmor]

t seems the headers in the raw data sheet have some formatting or line break which is not letting the array code work

We don't know what characters it can have, they can be special or blank spaces.

The simplest thing is that you delete the headers of your sheet and write them again or copy them from this line and paste them in their respective cell:

For Each vHeader In Array("Task Type", "User", "User Email Address", "User First Name", "User Last Name", "User Preferred Language")

 

[JoeMo]

Thank you Dante Amor and Joe. I tried both of your solutions but they give the same earlier results. It seems the headers in the raw data sheet have some formatting or line break which is not letting the array code work. Is there a way to get around this?

Below are the headers from the raw data sheet

User Email Address

User First Name

User Last Name

User Preferred Language

There's nothing unusual about the headers you posted - three words and two spaces each.

 

[Gogleguy]

Thank you both. The issue is the raw data sheet is something I cannot control. The column names in the raw data sheet remain same but not in the same order always. Hence I wanted to extract these columns onto another sheet so that I could use them for further analysis. Thank you again.

 

[DanteAmor]

The column names in the raw data sheet remain same but not in the same order always.

I hope at least the headers are in row 1.

If the headers are in another row, change the 1 in this line to the row number:

For j = 1 To ws_A.Cells(1, Columns.Count).End(xlToLeft).Column

Copy all of the following code into a module. Run the copycells macro. The macro executes a function (clean_head) to clean each header, leaving only letters, that is, it will eliminate all the special characters it may have, the most common are 10, 13 and 160, but the function checks all and only letters and the space between words remain.

Sub copycells()
  Dim ws_A As Worksheet, ws_B As Worksheet
  Dim i As Long, j As Long
  Dim vHeader As Variant
  Dim rngFound As Range
  Dim dic As Object
  Dim vlr As String
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set ws_A = Sheets("Sheet1")
  Set ws_B = Sheets("Sheet2")
  
  'assuming headers are in row 1
  For j = 1 To ws_A.Cells(1, Columns.Count).End(xlToLeft).Column
    vlr = clean_head(ws_A.Cells(1, j).Value)
    dic(vlr) = j
  Next
  
  For Each vHeader In Array("Task Type", "User", "User Email Address", "User First Name", "User Last Name", "User Preferred Language")
    If dic.exists(vHeader) Then
      i = i + 1
      ws_A.Range(ws_A.Cells(1, dic(vHeader)), ws_A.Cells(1, dic(vHeader)).End(xlDown)).Copy ws_B.Cells(1, i)
    End If
  Next
End Sub

Function clean_head(cell As String) As String
  Dim n As Long
  On Error Resume Next
  For n = 0 To 255
    If n < 32 Or (n > 32 And n < 65) Or (n > 90 And n < 97) Or n > 122 Then
      cell = Replace(cell, Chr(n), "")
    Else
      n = n
    End If
  Next
  clean_head = Trim(cell)
  On Error GoTo 0
End Function

 

[johnnyL]

Post from @Rick Rothstein

 

[Gogleguy]

This works perfect. Thank you so much Dante Amor. I appreciate