TextJoin copy formula all the way down to existing values on left automatically

[strat919]

Hey..... I'm recording a macro with =TEXTJOIN(",",TRUE,A1:B1) and the result is correct in C1. Then I double-click and get the results all the way down till there is no more data. Then I stop macro. I look at the vba code and the range is set to that particular macro.

Problem is when I use the macro for another set of different length columns, the macro already has the range set.

Can I enter something different in the A1:B1 to just tell it to give the result all the way to end of column till the data ends?

I have many sets of A B columns and want to include this macro inside of 6 combined macros to automate.

Do I need a custom vba macro.... which I don't know how to do.

Also I need it to replace the results in C column with unique values and column A and B deleted. I guess all that can be done with a custom vba macro if TEXTJOIN cannot be used in a macro I record myself.

I want to thank Yongle, Michael M, and Irobbo314 for their help on the other macros

Any help much appreciated

 

[alansidman]

Post your recorded Macro so that it can be amended to allow for the last row to be set as a variable.

 

[Fluff]

How about

Sub strat919()
   With Range("C1:C" & Range("A" & Rows.Count).End(xlUp).Row)
      .Formula = "=TEXTJOIN("","",TRUE,A1:B1)"
   End With
End Sub

 

[strat919]

Sub MergeAddComma()
'
' MergeAddComma Macro
'

'
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=TEXTJOIN("","",TRUE,RC[-2]:RC[-1])"
    Range("C1").Select
    Selection.AutoFill Destination:=Range("C1:C41")
    Range("C1:C41").Select
    Columns("C:C").Select
    Selection.Copy
    Columns("C:C").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
End Sub

 

[strat919]

Thanks Fluff ... but if I record an additional macro selecting column C copying and pasting special, values, deleting column A and B, I end up getting a specific range again. I guess it needs to be included also in the code.

 

[strat919]

I tried this..... it works, but all of column A is selected after operation which interferes with my next macro. Column A needs to be selected only to last cell with a value. The entire result should have only A column selected with results.

Sub MergeAddComma()
   With Range("C1:C" & Range("A" & Rows.Count).End(xlUp).Row)
      .Formula = "=TEXTJOIN("","",TRUE,A1:B1)"
   Columns("C:C").Select
    Selection.Copy
    Columns("C:C").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft

   End With
End Sub

 

[Fluff]

How about

Sub strat919()
   With Range("C1:C" & Range("A" & Rows.Count).End(xlUp).Row)
      .Formula = "=TEXTJOIN("","",TRUE,A1:B1)"
      .Value = .Value
   End With
   Columns("A:B").Delete
End Sub

 

[strat919]

Thanks Fluff.... that worked perfectly

I tested the code I merged from previous post above and it doesn't seem to interfere with the next macro so I'm probably good to go on that. The problem is with the next macro. I have to set the range before I run it. If it would only create the amount of cells needed to complete the macro. It works well and will give results to multiple sheets, sometimes I'm getting millions of results that exceeds the row limitations. If I set it to Const maximum = 1048576 to handle any situation, it creates so many rows if not needed, and is hard to work with if I'm working with a smaller amount of rows. Thanks

Public Sub GetUniquePairs()
    Application.ScreenUpdating = False
    Const maximum = 1048576
    Dim lastRow As Long, thisRow As Long
    Dim i As Long, j As Long
    Dim ws As Worksheet, Results As Worksheet
    Dim Res(1 To maximum, 1 To 1) As Variant
    
    Set ws = ActiveSheet
    Set Results = Sheets.Add
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    thisRow = 1
    
    For i = 1 To lastRow - 1
        For j = i + 1 To lastRow
            c = c + 1
            Res(thisRow, 1) = ws.Cells(i, 1).Value & "," & ws.Cells(j, 1).Value
            thisRow = thisRow + 1
                If thisRow = maximum Then
                    thisRow = 1
                    Results.Cells(1, 1).Resize(maximum).Value = Res
                    Erase Res
                    Set Results = Sheets.Add
                End If
                If i = lastRow - 1 Then
                    Results.Cells(1, 1).Resize(maximum).Value = Res
                    Erase Res
                End If
        Next j
    Next i
End Sub

 

[Fluff]

As this is a totally new question, you will need to start a new thread.

 

[strat919]

ok......I'll do that....thanks Fluff