VBA to convert data from Row description to Column Header

[JmanSchu55]

I need help creating a Macro that will convert the data from my starting attached image, to the ending data. I manually pivot the data by filtering it by description, then do a formula for Hours and earnings to slide it over into the proper column. After that I save all formulas as values and remove the data from the original regular hour and amount column. I know there has to be a better way? The description column can have any number of pay types that are not always the same. I do this on many files, and would love a way to speed this process up. Let me know if possible, thank you in advance.

 

[DanteAmor]

Hi and welcome to MrExcel!

Understanding that each of the descriptions in column C are found in row 1 starting in column F, try the following macro:

Sub ConvertData()
  Dim i As Long
  Dim f As Range
  For i = 2 To Range("A" & Rows.Count).End(3).Row
    Set f = Range("E1:Z1").Find(Range("C" & i).Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      Cells(i, f.Column).Resize(1, 2).Value = Range("D" & i).Resize(1, 2).Value
    End If
  Next
End Sub

 

[DanteAmor]

You can use the following formula:

Dante Amor
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Emp ID	Ch Date	Desc	Reg Hours	Reg Dollars	Hourly	Hourly	Reported Tips	Reported Tips	Salary	Salary	Tip Hourly	Tip Hourly
2	26	07-ene	Hourly	90	25	90	25
3	7	07-ene	Tip Hourly	72	88							72	88
4	7	07-ene	Reported Tips	38	8			38	8
5	2	07-ene	Tip Hourly	22	24							22	24
6	2	07-ene	Reported Tips	0	40			0	40
7	1	07-ene	Tip Hourly	37	44							37	44
8	8	07-ene	Reported Tips	43	14			43	14
9	15	07-ene	Salary	44	97					44	97
10	17	07-ene	Hourly	22	88	22	88
11	10	07-ene	Hourly	66	70	66	70
12	10	07-ene	Tip Hourly	81	93							81	93
13	10	07-ene	Hourly	79	61	79	61
Start

Cell Formulas
Range	Formula
F2:M13	F2	=IF(F$1=$C2,IF(F$1<>E$1,$D2,$E2),"")

Or this simplified macro:

Sub ConvertData_2()
  With Range("F2:M" & Range("A" & Rows.Count).End(3).Row)
    .Formula = "=IF(F$1=$C2,IF(F$1<>E$1,$D2,$E2),"""")"
    .Value = .Value
  End With
End Sub

 

[JmanSchu55]

checking it now

 

[JmanSchu55]

That works, is there a way to create the Headers from the description list? It would be "Description" Hours "Description"Amount for each Unique description in column C

 

[DanteAmor]

is there a way to create the Headers from the description list? It would be "Description" Hours "Description"Amount for each Unique description in column C

I recommend that you create the headers before the formulas or the macro, that way you will position them in the place that is convenient for you.

 

[JmanSchu55]

Appreciate the help today!

 

[DanteAmor]

is there a way to create the Headers from the description list? It would be "Description" Hours "Description"Amount for each Unique description in column C

Column names will be created in order of appearance.

Try this:

Sub ConvertData()
  Dim i As Long, lc As Long
  Dim f As Range
  For i = 2 To Range("A" & Rows.Count).End(3).Row
    Set f = Range("E1:Z1").Find(Range("C" & i).Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      lc = f.Column
    Else
      lc = Cells(1, Columns.Count).End(1).Column + 1
      Cells(1, lc).Resize(1, 2).Value = Range("C" & i).Value
    End If
    Cells(i, lc).Resize(1, 2).Value = Range("D" & i).Resize(1, 2).Value
  Next
End Sub

 

[JmanSchu55]

That is doing it exactly! Fantastic Thank you!