Program to combine information from two columns of an Excel spreadsheet

Can you tell me the answer which you are looking for then accordingly i can tell you about how to do the same??

Yes. On the image above or if you see in the file I uploaded, on the rows 18, 19 and 20 for example in Column B it says C202, C203 and C204.  

I am trying to pull that information and the corresponding information of each of those from Column R where it says HORIZONTAL GEOMETRY PLAN and have it output to a new sheet,

sorted as C202-C204 HORIZONTAL GEOMETRY PLAN. (So it takes all the numbers with HORIZONTAL GEOMETRY PLAN and just puts the C202-C204 in order with a dash and just lists HORIZONTAL GEOMETRY PLAN once.

So the C202, C203 and C204 combine in one column as C202-C204 and right next to that is HORIZONTAL GEOMETRY PLAN just listed once. We are trying to get it to do it automatically for all of the column B.  

We are trying to get it to do it for all the data in columns B and R to a new sheet.

Can you show me when it puts the output how do you want to see that output??

Also let's say for our assumptions even in row--30-32 it says HORIZONTAL GEOMETRY PLAN.. then will you want to move them in the same sheet or a different worksheet??

Saurabh...

Here, let me post some images and seeing it will help more. The example below is taking from rows 18-20, column B and then rows 28-31 and putting next to them is column R (the description into a new sheet just called Sheet1 in the workbook.

The file with the new worksheet to get a better idea.
Title_Frame_Register.xls

Rows 43 and 44 Before

Rows 43 and 44 after on Sheet 1

You can create a Pivot Table to get all the Column B data listed for each Column R item.

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?
Copy-of-Title_Frame_Register.xls

"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.

Their you go...Basis of your data you can run this code and it will do what you are looking for...

Every time it will create a new sheet when you run the macro..Enclosed is your workbook where you will find sheet3 which does what you want...

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("B2: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 str <> "" And str1 <> "" Then
                If ws1.Range("A1").Value = "" Then
                    ws1.Range("A1").Value = str
                    str = ""
                    ws1.Range("B1").Value = str1
                    str1 = ""
                Else
                    lr = ws1.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1
                    ws1.Range("A" & lr).Value = str
                    str = ""
                    ws1.Range("B" & lr).Value = str1
                    str1 = ""
                End If
            End If
        End If
    Next cell
End Sub

Select allOpen in new window

Saurabh...
Title_Frame_Register-1.xls

Thank you very much for that.

 May I just ask if we wanted to include all the "other" data like the single row items, how could we modify your script to include those as well?

I am sorry to trouble you with the extra but I know the engineer may in-turn ask for this.

That is looking perfect I think. Thank you very much. I am just amazed how you can do such things. It has been too long for me doing VB and I was never anywhere nearly that good.

regsamp..Thanks for the Kind words..Appreciate it..and it takes hard work and practice and practice and practice..And i keep on doing that..read and browse lot of logics because at the end of the day vba is logics..and the more you write logics more better you become...

You are very welcome. Thank you again for the great solution and the good advice.  I will test and then try and set it up into production and update.

Sure and feel free to reach out to me if you need any help..otherwise i'm assuming you going to close this question soon as this is solved..

Always Happy to help.. :-)

Saurabh...

I hate to ask for anything extra and I can ask a new question if you want but is it possible to create the new sheet with the name always "Sheet Index"?

Use this code...

Sub createsheets()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    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

    On Error Resume Next
    Sheets("Index").Delete

    Set ws = Sheets("Title_Frame_Register")
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Index"
    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

Select allOpen in new window

Saurabh...

Thank you again. You have been invaluable and amazing work.

Excellent work from the contributors, very helpful and amazing work.

You are welcome..Always Happy to Help.. :-)

Saurabh...