Home » excel » excel – Concatenate columns(user selected) and replace them with new column

excel – Concatenate columns(user selected) and replace them with new column

Posted by: admin April 23, 2020 Leave a comment

Questions:

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

Illustration
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
How to&Answers:

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