Transposing dummy variables - excel

Question

I would like to transform the structure of an excel file so that I can import it into a system which needs it to be structured in a given way.
Here is a small extraction of the excel file. There is a combination of categorical variables such as Line of business and four dummy variables indicating which data categories are used in a given process - such as Customer.
| Process name | Line of business | Customer | Potential customer | Employee | Vendor |
|--------------|------------------|----------|--------------------|----------|--------|
| Ad campaign | Marketing | x | x | | x |
| Payroll | HR | | | x | x |
What I want is to change the structure so that a new row is created for each variation of the dummy variables, and with a Data category column that applies/transposes the relevant data category name. The desired output would look like this:
| Process name | Line of business | Data category |
|--------------|------------------|--------------------|
| Ad campaign | Marketing | Customer |
| Ad campaign | Marketing | Potential customer |
| Ad campaign | Marketing | Vendor |
| Payroll | HR | Employee |
| Payroll | HR | Vendor |
What I have tried is making a COUNTIF statement that counts the number of "x" per row. I have then used a vba script that creates a new line with the process name for each variation of data categories.
Here is the code and the letters in the script refers to the columns in excel, so A is the Process name column and G is the COUNTIF column and it creates the n number of rows I need.
Sub KopyKat()
Dim N As Long, i As Long, K As Long
Dim v As String, kk As Long, m As Long
N = Cells(Rows.Count, "G").End(xlUp).Row
K = 1
For i = 2 To N
kk = Cells(i, "G").Value
v = Cells(i, "A").Value
For m = 1 To kk
Cells(K + 1, "H") = v
K = K + 1
Next m
Next i
End Sub
So that it goes from this:
| Process name | Line of business | Customer | Potential customer | Employee | Vendor | COUNTIF |
|--------------|------------------|----------|--------------------|----------|--------|---------|
| Ad campaign | Marketing | x | x | | x | 3 |
| Payroll | HR | | | x | x | 2 |
To this:
| Process name | Line of business | Customer | Potential customer | Employee | Vendor | COUNTIF | Process name_2 |
|--------------|------------------|----------|--------------------|----------|--------|---------|----------------|
| Ad campaign | Marketing | x | x | | x | 3 | Ad campaign |
| Payroll | HR | | | x | x | 2 | Ad campaign |
| | | | | | | | Ad campaign |
| | | | | | | | Payroll |
| | | | | | | | Payroll |
This is where my limited vba knowledge have taken me. I would like to change the code so that I get my desired output.
Thanks in advance!

Answer 1

Done simply with Power Query (available in Excel 2010+)
All steps can be done from the UI, but the M-code is below
Edit: Added step to rename Attribute column
Get data from table/range
Select the first two columns, then Unpivot Other Columns
Filter the Value column to show only the x's
Delete the Value column
Rename Attribute column --> Data Category
M-Code
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"Process name", type text}, {"Line of business", type text}, {"Customer", type text}, {"Potential customer", type text}, {"Employee", type text}, {"Vendor", type text}}),
#"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Process name", "Line of business"}, "Attribute", "Value"),
#"Filtered Rows" = Table.SelectRows(#"Unpivoted Other Columns", each ([Value] = "x")),
#"Removed Columns" = Table.RemoveColumns(#"Filtered Rows",{"Value"}),
#"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Attribute", "Data Category"}})
in
#"Renamed Columns"

Answer 2

First of all, I recommend Power Query for data this kind of data manipulation.
Secondly, if you must do it this way, I think putting your data in an actual Excel table is much better for organizing your data and writing your code.
Anyways, below you can find my solution. Based on how many input columns you have, you can adjust the inner loop.
Note: looping over cells one by one is not the most efficient way. If the data size is big, reading the values into an array, and changing them in memory will increase the calculation speed 100+ times. If you can provide more information about the data size, I can update my answer accordingly.
Option Explicit
Sub KopyKat()
Dim totalRow As Long
totalRow = Cells(Rows.Count, "A").End(xlUp).Row
'Result and data input sheets are specified here.
Dim wsInput As Worksheet: Set wsInput = Worksheets("Sheet5")
Dim wsOutput As Worksheet: Set wsOutput = Worksheets("Sheet6")
Dim i As Long 'Row
Dim j As Long 'Column
Dim counter As Long: counter = 0
For i = 2 To totalRow
For j = 3 To 6 'Column numbers are hardcoded for the sake of the example
'Assumption is that value "x" is the only way to specify
If wsInput.Cells(i, j).Value = "x" Then
With wsOutput
.Cells(counter + 2, 1) = wsInput.Cells(i, 1).Value 'Process Name
.Cells(counter + 2, 2) = wsInput.Cells(i, 2).Value 'Line of Business
.Cells(counter + 2, 3) = wsInput.Cells(1, j).Value 'Data Category
End With
counter = counter + 1
End If
Next j
Next i
End Sub

Answer 3

Check this code and customize it according to your needs:
Based on this data layout:
Sub Transpose()
Dim evalSheet As Worksheet
Dim evalRange As Range
Dim headerRange As Range
Dim evalCell As Range
Dim destCell As Range
Dim sheetName As String
Dim sourceRangeAddress As String
Dim headerRangeAddress As String
Dim destinationCellAddress As String
Dim rowCounter As Long
' Customize to fit your needs
sheetName = "Sheet1"
sourceRangeAddress = "A2:F3"
headerRangeAddress = "A1:F1"
destinationCellAddress = "I2"
Set evalSheet = ThisWorkbook.Worksheets(sheetName )
' Get the range
Set evalRange = evalSheet.Range(sourceRangeAddress)
Set headerRange = evalSheet.Range(headerRangeAddress)
Set destCell = evalSheet.Range(destinationCellAddress)
' Loop through each cell in the first column
For Each evalCell In evalRange.Columns(1).Cells
' Evaluate the four columns (columnOffset means how many columns to the right)
If Trim(evalCell.Offset(columnOffset:=2).Value) = "x" Then
destCell.Offset(rowOffset:=rowCounter, columnOffset:=0).Value = Trim(evalCell.Offset(columnOffset:=0).Value)
destCell.Offset(rowOffset:=rowCounter, columnOffset:=1).Value = Trim(evalCell.Offset(columnOffset:=1).Value)
' Header range cells (3) means the third cell in the range - different than offset
destCell.Offset(rowOffset:=rowCounter, columnOffset:=2).Value = Trim(headerRange.Cells(3).Value)
rowCounter = rowCounter + 1
End If
If Trim(evalCell.Offset(columnOffset:=3).Value) = "x" Then
destCell.Offset(rowOffset:=rowCounter, columnOffset:=0).Value = Trim(evalCell.Offset(columnOffset:=0).Value)
destCell.Offset(rowOffset:=rowCounter, columnOffset:=1).Value = Trim(evalCell.Offset(columnOffset:=1).Value)
destCell.Offset(rowOffset:=rowCounter, columnOffset:=2).Value = Trim(headerRange.Cells(4).Value)
rowCounter = rowCounter + 1
End If
If Trim(evalCell.Offset(columnOffset:=4).Value) = "x" Then
destCell.Offset(rowOffset:=rowCounter, columnOffset:=0).Value = Trim(evalCell.Offset(columnOffset:=0).Value)
destCell.Offset(rowOffset:=rowCounter, columnOffset:=1).Value = Trim(evalCell.Offset(columnOffset:=1).Value)
destCell.Offset(rowOffset:=rowCounter, columnOffset:=2).Value = Trim(headerRange.Cells(5).Value)
rowCounter = rowCounter + 1
End If
If Trim(evalCell.Offset(columnOffset:=5).Value) = "x" Then
destCell.Offset(rowOffset:=rowCounter, columnOffset:=0).Value = Trim(evalCell.Offset(columnOffset:=0).Value)
destCell.Offset(rowOffset:=rowCounter, columnOffset:=1).Value = Trim(evalCell.Offset(columnOffset:=1).Value)
destCell.Offset(rowOffset:=rowCounter, columnOffset:=2).Value = Trim(headerRange.Cells(6).Value)
rowCounter = rowCounter + 1
End If
Next evalCell
End Sub
Remember to mark the answer if this helps