[Fierro]

How to combine Excel spreadsheet columns information in one ?t

[Adan]

“As far as listing them on a single cell in “C202-C204″ might not be possible because your numbering process won’t be recognizable to Excel, what with the C in front of the number–and what if there’s a gap? E.g. C202, C203 & C207?” Thank you for the example.

Right, that is one of the many problems I was having Katie. The engineer is insisting it must have the C or the corresponding letter with it. Then they also don’t want a button pressed but it just to be automatically outputted to once the information was added in column B and R.

[SapnaVishwas]

Their you go..code for your reference

Sub createsheets()

    Dim rng As Range, cell As Range, lrow As Long
    Dim ws As Worksheet, ws1 As Worksheet
    Dim str As String, lr As Long, str1 As String
    Set ws = Sheets("Title_Frame_Register")
    Sheets.Add after:=Sheets(Sheets.Count)
    Set ws1 = ActiveSheet
    ws.Select
    lrow = ws.Cells(Cells.Rows.Count, "r").End(xlUp).Row
    Set rng = ws.Range("B5:b" & lrow)
    For Each cell In rng
        If ws.Range("R" & cell.Row).Value = ws.Range("R" & cell.Row + 1).Value Then
            str1 = ws.Range("R" & cell.Row).Value
            If str = "" Then
                str = cell.Value & "-" & cell.Offset(1, 0).Value
            Else
                str = Left(str, InStr(1, str, "-", vbTextCompare) - 1) & "-" & cell.Offset(1, 0).Value
            End If
        Else
            If ws1.Range("A1").Value = "" Then
                lr = 1
            Else
                lr = ws1.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1
            End If
            If str <> "" And str1 <> "" Then
                ws1.Range("A" & lr).Value = str
                ws1.Range("B" & lr).Value = str1
                str = ""
                str1 = ""
                Else
                 ws1.Range("A" & lr).Value = cell.Value
            ws1.Range("B" & lr).Value = ws.Range("R" & cell.Row).Value
            End If
           
        End If
    Next cell
    ws1.Cells.EntireColumn.AutoFit
End Sub