combining column data with a twist

[Boost001]

Hi there, I am trying to combine data in N columns into 2 columns where ColumnA is "\" separated, with ColumnB being the next entry to be added to ColumnA. To add to that, columnC should read either "Leaf" or "Branch" depending if this is the last column in the row.

So, my source data will look like (using , to denote new columns)

Mill1,Motor,Overheated
Mill1,Motor,Bearing
Mill1,Clutch,Disengaged
Mill1,In feed,No Feed

etc...

The output would be (the first column of the first row would be blank)
,Mill1,"Branch"
Mill1,Motor,"Branch"
Mill1\Motor,Overheated,"Leaf"
Mill1\Motor,Bearing,"Leaf"
Mill1,Clutch,"Branch"
Mill1\Clutch,Disengaged,"Leaf"
Mill1,In feed,"Branch"
Mill1\In feed,No Feed,"Leaf"

Hopefully this makes sense, I have attached an image of the before and after that I would like to see. I am not a programmer so have tried to use AI to generate some scripts for me, but they just aren't working and I don't know enough to debug them.

 

[arun_eagertolearn]

Hi

Please check whether this is ok

This involves a series of steps to transform the input to the output format you want

Power Query would help, but have tried to do here using Excel

You may have the intermediate steps in hidden sheets/hidden columns

Tweaking columns.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	Input			Sl No		Step 1
2	Mill1	Motor	Overheated	1		Mill1	Mill1				Mill1		Motor	Motor		Mill1	Mill1\Motor	Overheated	Motor
3	Mill1	Motor	Bearing	2		Mill1	Mill1				Mill1		Motor	Motor		Mill1	Mill1\Motor	Bearing	Motor
4	Mill1	Clutch	Disengaged	3		Mill1	Mill1				Mill1		Clutch	Clutch		Mill1	Mill1\Clutch	Disengaged	Clutch
5	Mill1	Infeed	No Feed	4		Mill1	Mill1				Mill1		Infeed	Infeed		Mill1	Mill1\Infeed	No Feed	Infeed
6
7
8						Step 2	Stacking, removing duplicates
9						Mill1	Mill1	0	0
10						0	0	0	0
11						Mill1	0	Motor	Motor
12						Mill1	0	Clutch	Clutch
13						Mill1	0	Infeed	Infeed
14						Mill1	Mill1\Motor	Overheated	Motor
15						Mill1	Mill1\Motor	Bearing	Motor
16						Mill1	Mill1\Clutch	Disengaged	Clutch
17						Mill1	Mill1\Infeed	No Feed	Infeed
18
19
20
21
22						Step 3	Sorting
23						0	0	0	0
24						Mill1	Mill1	0	0
25						Mill1	0	Clutch	Clutch
26						Mill1	Mill1\Clutch	Disengaged	Clutch
27						Mill1	0	Infeed	Infeed
28						Mill1	Mill1\Infeed	No Feed	Infeed
29						Mill1	Mill1\Motor	Bearing	Motor
30						Mill1	0	Motor	Motor
31						Mill1	Mill1\Motor	Overheated	Motor
32
33
34
35						Step 4	Remove 0
36						Mill1	Mill1	0	0
37						Mill1	0	Clutch	Clutch
38						Mill1	Mill1\Clutch	Disengaged	Clutch
39						Mill1	0	Infeed	Infeed
40						Mill1	Mill1\Infeed	No Feed	Infeed
41						Mill1	Mill1\Motor	Bearing	Motor
42						Mill1	0	Motor	Motor
43						Mill1	Mill1\Motor	Overheated	Motor
44
45
46
47						Output (Step 5)	Arrange columns
48							Mill1	Branch
49						Mill1	Clutch	Branch
50						Mill1\Clutch	Disengaged	Leaf
51						Mill1	Infeed	Branch
52						Mill1\Infeed	No Feed	Leaf
53						Mill1\Motor	Bearing	Leaf
54						Mill1	Motor	Branch
55						Mill1\Motor	Overheated	Leaf
Sheet1

Cell Formulas
Range	Formula
F2:F5	F2	=A2
G2:G5	G2	=A2
M2:M5	M2	=B2
N2:N5	N2	=B2
P2:P5,R2:R5	P2	=A2
Q2:Q5	Q2	=A2&"\"&B2
S2:S5	S2	=B2
K2:K5	K2	=A2
F9:I17	F9	=UNIQUE(VSTACK(F2:I6,K2:N6,P2:S6))
F23:I31	F23	=SORTBY(F9#,F9:F17,1,I9:I17,1,H9:H17,1)
F36:I43	F36	=FILTER(F23#,F23:F31<>0)
F48:F55	F48	=IF(I36=0,"",IF(G36=0,F36,G36))
G48:G55	G48	=IF(F48="",G36,H36)
H48:H55	H48	=IF(ISNUMBER(SEARCH("\",F48,1)),"Leaf","Branch")
Dynamic array formulas.

 

[Boost001]

Thank you for the reply. I was looking at a scripted solution as I don't know how many columns and rows I may be given.

 

[Boost001]

so I spent a few days with Google and StackOverflow and managed to bash together a working script to do what I needed.

 

[Joe4]

so I spent a few days with Google and StackOverflow and managed to bash together a working script to do what I needed.

Would you mind posting your script/solution?
If you do that, it may help others in the future, and you can then mark that post as the solution to this question.

 

[Boost001]

So here is my code. I am ignoring the first row of the source data as that will contain some header information, and some specifics that I need in there which complicates things a little. I also have a check for invalid characters

Private Sub ReplaceSpecialCharacters()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim specialChars As String
    Dim replaceChar As String
    
    ' Define the worksheet to be processed
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' Update "Sheet1" with your sheet name
    
    ' Define the range to be processed (assuming data starts from A1)
    Set rng = ws.UsedRange
    
    ' Define the special characters to be replaced
    specialChars = "*?;{}[]|\`'"""
    
    ' Define the character to replace special characters with
    replaceChar = "_" ' You can change this to whatever character you want
    
    ' Loop through each cell in the range
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            ' Loop through each character in the cell's value
            For i = 1 To Len(cell.Value)
                ' Check if the character is a special character
                If InStr(specialChars, Mid(cell.Value, i, 1)) > 0 Then
                    ' Replace the special character with the desired character
                    cell.Value = Replace(cell.Value, Mid(cell.Value, i, 1), replaceChar)
                End If
            Next i
        End If
    Next cell
End Sub

Private Sub Concatenate()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim LastRow As Long
    Dim LastCol As Long
    Dim i As Long
    Dim concatenatedValue As String
    Dim Columni As String
    Dim j As Long
    Dim k As Long
Set SourceRange = Application.Selection
    k = 1

    ' Set the source worksheets
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    
    ' Create a new sheet and rename it
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("Sheet2").Delete
    On Error GoTo 0
    ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Sheet2"
    
    ' Set the target worksheets
    Set wsTarget = ThisWorkbook.Sheets("Sheet2")
    
    ' Find the last row with data in column A of the source sheet
    LastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    ' Loop through each row

    For i = 2 To LastRow
    LastCol = wsSource.Cells(i, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' Initialize concatenatedValue for each row
    concatenatedValue = "Reason Tree\"
    
    ' adding root elements
            If k = 1 Then
                wsTarget.Cells(1, 2).Value = "Reason Tree"
                wsTarget.Cells(1, 4).Value = "Reason Tree Root"
                k = k + 1
            End If
        
        wsTarget.Cells(k, 1).Value = concatenatedValue
        ' Loop through each column in the current row
        For j = 2 To LastCol

            wsTarget.Cells(k, 1).Value = concatenatedValue
            wsTarget.Cells(k, 2).Value = wsSource.Cells(i, j).Value
            concatenatedValue = concatenatedValue & wsSource.Cells(i, j).Value & "\"
            If j < LastCol Then
                wsTarget.Cells(k, 4).Value = "Reason Tree Node"
            Else
                wsTarget.Cells(k, 4).Value = "Reason Tree Leaf"
                wsTarget.Cells(k, 3).Value = "Root Categories\" & wsSource.Cells(i, 1).Value
            End If

            k = k + 1
        Next j
        ' Remove the trailing "\" from the concatenated value
        concatenatedValue = Left(concatenatedValue, Len(concatenatedValue) - 1)
        For l = 1 To Step - 1
            Set EntireRow = wsTarget.Cells(i, 1).EntireRow
            If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
                EntureRow.Delete
            End If
        Next l
    Next i
End Sub
Private Sub DeleteBlankRows()
  Dim SourceRange As Range
  Dim EntireRow As Range
Set SourceRange = Application.Selection
If Not (SourceRange Is Nothing) Then
    Application.ScreenUpdating = False
For i = SourceRange.Rows.Count To 1 Step -1
      Set EntireRow = SourceRange.Cells(i, 1).EntireRow
      If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
        EntireRow.Delete
      End If
    Next
Application.ScreenUpdating = True
  End If
End Sub
Private Sub RemoveDuplicates()
    Dim B As Long
    B = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:AA" & B).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
End Sub
Sub Run()
Call ReplaceSpecialCharacters
Call Concatenate
Call DeleteBlankRows
Call RemoveDuplicates
End Sub