Forum Discussion

Jyggalag77's avatar
Jyggalag77
Copper Contributor
Aug 11, 2022
Solved

Conditionally merge cells based on number?

Hi all,

I want my cell to be merged like this (see attached photo).

What defines my data is that there is always an age, so I would like to have, for example, a formula where once a number enters, it stops merging and starts merging in the next cell until another number appears and then moves to the next cell again, if that makes sense?

 

please help guys! 🙂

 

thanks!

 

kind regards,
Jyggalag

  • Jyggalag77 

    Sub merge()
    
    Dim i As Long
    Dim x As Variant
    Dim result As String
    Dim k As Long
    Dim m As Long
    
    Range("B:B").Clear
    
    m = Range("A" & Rows.Count).End(xlUp).Row
    k = 3
    
    For i = 3 To m
    
    x = Right(Cells(i, 1), 1)
    If IsNumeric(x) Then
    
    Cells(k, 2).Value = Trim(result & " " & Cells(i, 1).Value)
    k = k + 1
    result = ""
    
    Else
    
    result = Trim(result & " " & Cells(i, 1).Value)
    
    End If
    
    Next i
    
    End Sub

    Maybe with this code. In the attached file you can click the button in cell D2 to run the macro.

8 Replies

  • Jyggalag77 This does something similar with an Excel 365 formula.

    WorksheetFormula
    = LET(
       consolidated, REDUCE("", data, JoinToLastλ),
       DROP(consolidated,-1))
    
    JoinToLastλ 
    = LAMBDA(list, term,
        LET(
            initialLine?, ROWS(list) = 1,
            endBlock?,    ISNUMBER(VALUE(RIGHT(term, 1))),
            priorTerms,   IF(initialLine?, "None", DROP(list, -1)),
            finalTerm,    TEXTJOIN(",",,TAKE(list, -1), term),
            updatedList,  IF(initialLine?, finalTerm, VSTACK(priorTerms, finalTerm)),
            IF(endBlock?, VSTACK(updatedList, ""), updatedList)
        )
    );

    Not that it is going to look any more familiar than the VBA!

    What it does is to join each new term to the final element of an array but then appends a blank element if the term ends with a number.  

     

    • Jyggalag77's avatar
      Jyggalag77
      Copper Contributor
      Thank you so much Peter! I will make sure to take a look at this as well 🙂
  • Jyggalag77 

    Sub merge()
    
    Dim i As Long
    Dim x As Variant
    Dim result As String
    Dim k As Long
    Dim m As Long
    
    Range("B:B").Clear
    
    m = Range("A" & Rows.Count).End(xlUp).Row
    k = 3
    
    For i = 3 To m
    
    x = Right(Cells(i, 1), 1)
    If IsNumeric(x) Then
    
    Cells(k, 2).Value = Trim(result & " " & Cells(i, 1).Value)
    k = k + 1
    result = ""
    
    Else
    
    result = Trim(result & " " & Cells(i, 1).Value)
    
    End If
    
    Next i
    
    End Sub

    Maybe with this code. In the attached file you can click the button in cell D2 to run the macro.

    • Jyggalag77's avatar
      Jyggalag77
      Copper Contributor
      I am very new to VBA and have never coded myself, so I would love to understand the code. Please see my comments for the first sections so far.

      Would love a simple easy-to-understand explanation for the rest if possible! 🙂

      Code (my two comments have an ' before them):

      Option Explicit

      Sub merge_cells_together()

      'Name your variables wit the Dim as long, dim the result as a string and dim x as a variant (no specific data type)
      Dim i As Long
      Dim x As Variant
      Dim result As String
      Dim k As Long
      Dim m As Long

      'Clear all of column B
      Range("B:B").Clear

      m = Range("A" & Rows.Count).End(xlUp).Row
      k = 3

      For i = 3 To m

      x = Right(Cells(i, 1), 1)
      If IsNumeric(x) Then

      Cells(k, 2).Value = Trim(result & " " & Cells(i, 1).Value)
      k = k + 1
      result = ""

      Else

      result = Trim(result & " " & Cells(i, 1).Value)

      End If

      Next i

      End Sub
      • OliverScheurich's avatar
        OliverScheurich
        Gold Contributor

        Jyggalag77 

        Sub merge()
        
        'Name your variables wit the Dim as long, dim the result as a string and dim x as a variant (no specific data type)
        
        Dim i As Long
        Dim x As Variant
        Dim result As String
        Dim k As Long
        Dim m As Long
        
        'Clear all of column B
        Range("B:B").Clear
        
        'Automatically determine the last row with data in column A
        
        m = Range("A" & Rows.Count).End(xlUp).Row
        
        'Initiating k (the results should be displayed starting in row 3)
        k = 3
        
        'run through all rows from 3 to m
        For i = 3 To m
        
        'extract the rightmost digit from cells(i,1)
        x = Right(Cells(i, 1), 1)
        
        'check if digit is numeric
        If IsNumeric(x) Then
        
        'concatenate the result (currently existing strin) with value of cells(i,1)
        'then trim the result(remove space in front of the concatenated string)
        'enter the string in cells(k,2)
        
        Cells(k, 2).Value = Trim(result & " " & Cells(i, 1).Value)
        
        'increase k by 1. the next result will be shown 1 row below
        k = k + 1
        
        'clear result in order to concatenate new strings
        result = ""
        
        Else
        
        'concatenate the result (currently existing string) with value of cells(i,1)
        'then trim the result (remove space in front of the concatenated string)
        result = Trim(result & " " & Cells(i, 1).Value)
        
        End If
        
        'select next i (next row in this code)
        Next i
        
        End Sub

        You are welcome. Glad the suggestion is helpful. In the attached file the comments are added to the code.

    • Jyggalag77's avatar
      Jyggalag77
      Copper Contributor
      Dear Quadruple_Pawn,

      This is absolutely amazing! I simply do not know how to thank you enough for this 🙂

      You have truly saved my day. Thank you so much sir!

      If you have the spare time, I would love to get a breakthrough of what each section of the code does so I can understand it (if you can add notes to it maybe?). Otherwise, your help has truly been appreciated!!!

      Thank you very much for this!!!

Resources