VBA code grouped into 1 line according to item

[Excelpromax123]

Hello everyone. I need to edit the vba code below to apply to many lines (as shown in the image). Currently, I can only write the code for the first line. Thank you very much

Test VBA.xlsb

drive.google.com

Sub RunMainCode() ' original code, unmodified
    Dim lastRow As Long
    Dim i As Long
    Dim combinedText As String
    Dim lineHeight As Double
    Dim numLines As Long
    Dim cellWidth As Double

    ' Start combining from cell A3
    combinedText = Range("K9").Value & vbCrLf

    ' Loop through the cells from B3 to B(lastRow) and combine them into combinedText
    For i = 9 To 12
        combinedText = combinedText & Range("L" & i).Value & " x " & Range("M" & i).Value & " x " & Range("N" & i).Value & " = " & Range("O" & i).Value & vbCrLf
    Next i

    ' Assign the combined content to cell A1
    Range("B2").Value = Trim(combinedText)

    ' Format the first line in cell A1 (make the first part bold)
    Range("B2").Font.Bold = False
    With Range("B2").Characters(1, Len(Range("K9").Value)).Font
        .Bold = True
    End With

    ' Calculate the number of lines in cell A1
    numLines = UBound(Split(Range("B2").Value, vbLf)) + 1
    Rows("2:2").RowHeight = 16 * numLines

    Range("C2").Value = Range("L7").Value ' temporary number
    Range("D2").Value = Range("O7").Value ' temporary number
End Sub
Please note

 

[RajeshKumar1313]

Use this one

Sub RunMainCode() ' original code, unmodified
Dim lastrow As Long
Dim i As Long
Dim combinedText As String
Dim lineHeight As Double
Dim numLines As Long
Dim cellWidth As Double

' Start combining from cell A3

lastrow = ActiveSheet.Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).Row - 1

Dim x As Integer
x = 10
' Loop through the cells from B3 to B(lastRow) and combine them into combinedText
For i = 2 To 4
'i = x - 1
combinedText = Range("K" & x).Value & vbCrLf
combinedText = combinedText & Range("L" & (x - 1)).Value & " x " & Range("M" & (x - 1)).Value & " x " & Range("N" & (x - 1)).Value & " = " & Range("O" & (x - 1)).Value & vbCrLf

Do While (ActiveSheet.Range("K" & x).Value = ActiveSheet.Range("K" & (x - 1)).Value)
If IsEmpty(ActiveSheet.Range("K" & x).Value) Then
Exit Do
Else
combinedText = combinedText & Range("L" & (x)).Value & " x " & Range("M" & (x)).Value & " x " & Range("N" & (x)).Value & " = " & Range("O" & (x)).Value & vbCrLf
x = x + 1
End If
Loop
Range("B" & i).Value = Trim(combinedText)
Range("B" & i).Font.Bold = False
With Range("B" & i).Characters(1, Len(Range("K" & i).Value)).Font
.Bold = True
End With

' Calculate the number of lines in cell A1
numLines = UBound(Split(Range("B" & i).Value, vbLf)) + 1
Rows("2:2").RowHeight = 16 * numLines
Range("C" & i).Value = Range("L7").Value ' temporary number
Range("D" & i).Value = Range("O7").Value ' temporary number


x = x + 1
Next i

End Sub