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

[fr0z3nfyr]

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'm now stuck with concatenating the columns for categories using "|" as a separator and put the values in first category column(level1). Please help me do this.

My code is like below:

<code>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</code></pre>

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.

 

[vaskov17]

Sub Main()
    Dim col As Integer
    Dim c As Long
    Dim r As Long
    Dim txt As String
    
    col = InputBox("Enter last column:")
    
    For r = 1 To ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
        For c = 1 To col
            txt = txt & ActiveSheet.Cells(r, c).Text & "|"
        Next
        
        If Right(txt, 1) = "|" Then
            txt = Left(txt, Len(txt) - 1)
        End If
        
        ActiveSheet.Range("A" & r) = txt
    Next
    
End Sub

 

[fr0z3nfyr]

Thanks for your time vaskov17, I tried your macro and nothing happened at all, no change in worksheet.
I'm trying to attacha sample file but I don't know how i can attach an excel file in the editor. I'm new to the forums, I'm sorry. I'll try to show a sample in attached image.

If you noticed, the number of columns for levels may vary from 3-10 in every excel file, i.e., if level 5 is deepest level for project, there will be 5 columns, if the deepest level is 8, there will be 8 columns. Further, the columns order is not fixed, i.e., it may or ma not begin from Column E.

How can i do this all dynamically by taking user input, my head is is about to burst anytime now.

 

[vaskov17]

try this one:

keep in mind this one has pretty much no error checking and there could be other issues

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

 

[fr0z3nfyr]

Works perfectly, can't thank you enough for the help. Now I'm trying to implement this in my macro. I'll come back if i need more help. Thanks again.

 

[fr0z3nfyr]

Works perfectly

Only thing missing is that it does not delete the empty columns in between- level 2, level 3...etc. but i can try to do that.

 

[vaskov17]

I didn't realize you wanted the columns deleted and thought you wanted the cells emptied.

Try this and let me know if it works since I haven't actually tested it. Also let me know if you need any of the code explained as I haven't put comments in.

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 & "|"
            End If
        Next
        
        If Right(txt, 1) = "|" Then
            txt = Left(txt, Len(txt) - 1)
        End If
        
        Cells(r, start) = txt
        txt = ""
    Next
    
    Range(Cells(1, start + 1), Cells(1, finish)).EntireColumn.Delete
End Sub

 

[fr0z3nfyr]

I didn't realize you wanted the columns deleted and thought you wanted the cells emptied.

I was able to do it already, i used exactly same thing except that I didn't already know that .Delete would auto shift to left without Shift:=xlToLeft

I'm pretty much able to understand your code, I'm just trying to put it in my code or call it in my macro. Right now, I'm trying to use something like

Dim rngMyrange As Range

as in my code instead of

Dim start As Long 
Dim finish As Long 
Dim c As Long

Calling it in my macro will be a final resort for me. Can you please help?

 

[vaskov17]

Sub Main()
    Dim myRange As Range
    Dim c As Long
    Dim r As Long
    Dim txt As String
    
    Set myRange = Application.InputBox("Enter range:", Type:=8)
    
    For r = 1 To myRange.Rows.Count
        For c = 1 To myRange.Columns.Count
            If myRange(r, c).Text <> "" Then
                txt = txt & myRange(r, c).Text & "|"
            End If
        Next
        
        If Right(txt, 1) = "|" Then
            txt = Left(txt, Len(txt) - 1)
        End If
        
        myRange(r, 1) = txt
        txt = ""
    Next
    
    Range(myRange(1, 2), myRange(1, myRange.Columns.Count)).EntireColumn.Delete
End Sub

 

[fr0z3nfyr]

Thanks vaskov17 for your help. Though this does not look for used cells if i select columns, this is still good to go. I can select the cells that i want.