Concatenate columns(user selected) and replace them with new column - vba

Question

I'm not an advanced VBA programmer. I'm working on an excel macro which will allow me to select a range(using input box) to clean the data(makes consistent with mySQL schema) on worksheet. I get this file from anther team and
1.) the order of columns is not fixed
2) levels of categories(there are few columns for categories like level1 level2 etc.) can be anything between 3-10.
I want to concatenate the columns for categories(in image level 1, level 2 etc.) using | as a separator and put the values in first category column(level1) while deleting remaining columns(level 2, level 3...[level 10]).
I removed some code from the end to reduce the length here but it still makes sense:
Sub cleanData()
Dim rngMyrange As Range
Dim cell As Range
On Error Resume Next
Do
'Cleans Status column
Set rngMyrange = Application.InputBox _
(Prompt:="Select Status column", Type:=8)
On Error GoTo 0
'Is a range selected? Exit sub if not selected
If rngMyrange Is Nothing Then
End
Else
Exit Do
End If
Loop
With rngMyrange 'with the range just selected
.Replace What:="Dead", Replacement:="Inactive", SearchOrder:=xlByColumns, MatchCase:=False
'I do more replace stuff here
End With
rngMyrange.Cells(1, 1) = "Status"
Do
'Concatenates Category Columns
Set rngMyrange = Application.InputBox _
(Prompt:="Select category columns", Type:=8)
On Error GoTo 0
'Is a range selected? Exit sub if not selected
If rngMyrange Is Nothing Then
End
Else
Exit Do
End If
Loop
With rngMyrange 'with the range just selected
'Need to concatenate the selected columns(row wise)
End With
rngMyrange.Cells(1, 1) = "Categories"
End Sub
Please do not suggest a UDF, I want to do this with macro. I must do this on files before importing them on SQL database, so a macro will be handy. Please ask if I failed to mention anything else.
EDIT: Image attached for illustration
UPDATE:
I now have a working code with help from vaskov17 on mrexcel but it does not delete the columns from where the levels are picked-level 2, level 3...etc. to shift next columns to left and the major challenge for me is to implement that code in my existing macro using range type instead of long type. I do not want to enter start column and finish column separately, instead I should be able to select range like in my original macro. Code for that macro is below, please help me:
Sub Main()
Dim start As Long
Dim finish As Long
Dim c As Long
Dim r As Long
Dim txt As String
start = InputBox("Enter start column:")
finish = InputBox("Enter ending column:")
For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row
For c = start To finish
If Cells(r, c).Text <> "" Then
txt = txt & Cells(r, c).Text & "|"
Cells(r, c).Clear
End If
Next
If Right(txt, 1) = "|" Then
txt = Left(txt, Len(txt) - 1)
End If
Cells(r, start) = txt
txt = ""
Next
End Sub

Answer 1

I have removed the inputbox for selection of the category columns. Since they are always named Level x»y it makes it easier to find them automatically. That's why added a FindColumns() Sub to your code. It assigns the first fCol and last lCol Category column to global variables.
The ConcatenateColumns() concatenates cells in each row using "|" as separator.
The DeleteColumns() deletes the other columns
Cells(1, fCol).Value = "Category renames Level 1 to Category and Columns.AutoFit resizes all columns widths to fit the text.
Code:
Option Explicit
Dim fCol As Long, lCol As Long
Sub cleanData()
Dim rngMyrange As Range
Dim cell As Range
On Error Resume Next
Do
'Cleans Status column
Set rngMyrange = Application.InputBox _
(Prompt:="Select Status column", Type:=8)
On Error GoTo 0
'Is a range selected? Exit sub if not selected
If rngMyrange Is Nothing Then
End
Else
Exit Do
End If
Loop
With rngMyrange 'with the range just selected
.Replace What:="Dead", Replacement:="Inactive", SearchOrder:=xlByColumns, MatchCase:=False
'I do more replace stuff here
End With
rngMyrange.Cells(1, 1) = "Status"
' Concatenate Category Columns
FindColumns
ConcatenateColumns
DeleteColumns
Cells(1, fCol).Value = "Category"
Columns.AutoFit
End Sub
Private Sub FindColumns()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim i As Long, j As Long
For i = 1 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
If StrComp(ws.Cells(1, i).Text, "Level 1", vbTextCompare) = 0 Then
For j = i To ws.Cells(1, Columns.Count).End(xlToLeft).Column
If InStr(1, ws.Cells(1, j).Text, "Level", vbTextCompare) Then
lCol = j
End If
Next j
fCol = i
Exit Sub
End If
Next i
End Sub
Private Sub ConcatenateColumns()
Dim rng As Range
Dim i As Long, j As Long
For i = 2 To Cells(Rows.Count, fCol).End(xlUp).Row
Set rng = Cells(i, fCol)
For j = fCol + 1 To lCol
rng = rng & "|" & Cells(i, j)
Next j
rng = "|" & rng & "|"
Set rng = Nothing
Next i
End Sub
Private Sub DeleteColumns()
Dim i As Long
For i = lCol To fCol + 1 Step -1
Columns(i).Delete Shift:=xlToLeft
Next i
End Sub