Match column headers and copy over data

[suptechguy]

I am starting a new project to simplify an uploading process. I would like to create a workbook that is set up like this:

Two sheets, one is called “Upload Data”, and the other is called “Prepared File. The “Prepared File” sheet has the column headers in the correct order for the upload to work properly. When users copy and paste data into the “Upload Data” sheet, then the data for each column will copy into sheet “Prepared File’ and will be arranged in the correct order.



I think the logic would look something like this:

In sheet (“Prepared File”) in range (“9:9”)

Match each column header (A9, B9, C9, …) with the column headers in sheet (“Upload data”) in range (“A:A”).

If exact match is found, copy the data in that column from Sheet (“Upload Data”) into the matching column on sheet (“Prepared File”)

If a match is not found, then put a (“x”) above that column (A8, B8, C8, …) in sheet (“Prepared File”)



Please help. Thank!

 

[Peter_SSs]

Welcome to the MrExcel board!

Are you looking for a macro or a formula approach?

 

[suptechguy]

Probably a formula would be simpler but either one I could work with

 

[suptechguy]

Probably a formula would be simpler but either one I could work with

I would be interested in seeing the solution for both if that's not too much to ask

 

[suptechguy]

So basically, each column header in row (10:10) of sheet ("Prepared File") needs to find the matching column header in row (1:1) of sheet ("Upload Data")
If a match is found, copy the data in that column of sheet ("Upload Data") into the matching column of sheet ("Prepared File")
'If there is no match, place an 'x' above the column header in sheet ("Prepared File") to show that there was no match

I think VBA will be the best choice now

 

[Peter_SSs]

I think VBA will be the best choice now

Give this a try in a copy of your workbook.

Sub Copy_Columns()
  Dim wsUD As Worksheet, wsPF As Worksheet
  Dim rCell As Range, rFound As Range
  
  Set wsUD = Sheets("Upload Data")
  Set wsPF = Sheets("Prepared File")
  With wsPF
    For Each rCell In .Range("A10", .Range("A10").End(xlToRight))
      Set rFound = wsUD.Rows(1).Find(What:=rCell.Value, LookAt:=xlWhole, MatchCase:=False)
      If rFound Is Nothing Then
        rCell.Offset(-1).Value = "x"
      Else
        wsUD.Range(wsUD.Cells(2, rFound.Column), wsUD.Cells(Rows.Count, rFound.Column).End(xlUp).Offset(1)).Copy Destination:=rCell.Offset(1)
      End If
    Next rCell
  End With
End Sub

My sample data

Book1
	A	B	C
1	Guy	Other	Super
2	Guy 1	Other 1	Super 1
3	Guy 2	Other 2	Super 2
4	Guy 3	Other 3	Super 3
5	Guy 4	Other 4	Super 4
6	Guy 5		Super 5
7	Guy 6		Super 6
8	Guy 7
9
Upload Data

Results of code when this sheet originally just had the green cells.

Book1
	A	B	C
9		x
10	Super	Tech	Guy
11	Super 1		Guy 1
12	Super 2		Guy 2
13	Super 3		Guy 3
14	Super 4		Guy 4
15	Super 5		Guy 5
16	Super 6		Guy 6
17			Guy 7
18
Prepared File

 

[suptechguy]

This is brilliant thank you! What if I want an "x" to also appear above the column headers of sheet ("Upload Data"). That way, users can see which columns they need to fix on the Upload Tab. When they fix the columns and press the button again, the columns with the x's should reset. Can this be adjusted?

 

[Peter_SSs]

What if I want an "x" to also appear above the column headers of sheet ("Upload Data").

In my example do you mean mark the 'Other' column in 'Upload Data'?

If so try adding these two blue lines where shown.

  Set wsPF = Sheets("Prepared File")
  wsUD.Range("A1", wsUD.Cells(1, Columns.Count).End(xlToLeft)).Interior.Color = vbYellow
  With wsPF
.
.
      Else
        rFound.Interior.Color = xlNone
        wsUD.Range(wsUD.Cells(2, rFound.Column), wsUD.Cells(Rows.Count, rFound.Column).End(xlUp).Offset(1)).Copy Destination:=rCell.Offset(1)

If that is not what you meant, please clarify further.

 

[suptechguy]

Sorry for the delay in response..
Thank you very much! That's exactly what I was looking for

The last issue I am having with it is this:
The highlighting (now red) on sheet ("Upload Data") is happening on the exact row of the headers but I would like it to happen to the cells above the headers. When I try to adjust the code, the highlighting will highlight both the header row and the row above it but only the header row will use the matching logic to choose which cells to highlight; meaning the row above the headers will be completely highlighted red no matter the matching.

Here's what I got for code:

Private Sub CommandButton1_Click()
 Dim wsUD As Worksheet, wsPF As Worksheet
  Dim rCell As Range, rFound As Range
  
  Set wsUD = Sheets("Upload Data")
  Set wsPF = Sheets("Prepared File")
  
  wsPF.Range("9:9").ClearContents
  wsPF.Range("11:50000").ClearContents
  wsUD.Range("A3", wsUD.Cells(3, Columns.Count).End(xlToRight)).Interior.Color = vbRed
  With wsPF
    For Each rCell In .Range("A10", .Range("A10").End(xlToRight))
      Set rFound = wsUD.Rows(3).Find(What:=rCell.Value, LookAt:=xlWhole, MatchCase:=False)
      If rFound Is Nothing Then
        rCell.Offset(-1).Value = "x"
        '****
       
        '****
      Else
      rFound.Interior.Color = xlNone
        wsUD.Range(wsUD.Cells(4, rFound.Column), wsUD.Cells(Rows.Count, rFound.Column).End(xlUp).Offset(1)).Copy Destination:=rCell.Offset(1)
      End If
    Next rCell
  End With
  
  
End Sub

 

[Peter_SSs]

Not certain I have understood what you want on wsUD, by try making these 2 changes

wsUD.Range("A3", wsUD.Cells(3, Columns.Count).End(xlToRight)).Interior.Color = vbRed
wsUD.Range("A3", wsUD.Cells(3, Columns.Count).End(xlToLeft)).Offset(-1).Interior.Color = vbRed


rFound.Interior.Color = xlNone
rFound.Offset(-1).Interior.Color = xlNone