Combining Rows in Excel

babs · #1 07-10-2014, 12:32 PM

I have seen similar posts to this, but none quite like what I need help with...

I have a sheet where each row is an agreement, but not every cell in that row has a value and information for one agreement could be spread out onto multiple rows. I want each unique agreement to have one row. In the attached sample you will see there are a lot of blank cells on each row and information for one agreement number could be spread out between about six lines. If I could get everything associated with the same agreement/sub number on one line and have the other ones removed that would be great! I feel like when I go through options in my head it becomes much more complicated than it should be! The current sheet I'm working from has about 23,000 lines in it, so this will be a huge help!

charlesdh · #2 07-10-2014, 04:02 PM

Hi,

Can you provide a example of the result you are looking for?

excelledsoftware · #3 07-12-2014, 08:48 AM

Hi Babs,

I am working on this code for you. Basically you need something that will sort the data, look through the groups, grab each bit of data in the columns and then export them to a new worksheet on their own row. Then go to the next group. If each group has about 8 rows each for estimation, your results should be around 3000 rows. I plan on having it written today.

excelledsoftware · #4 07-13-2014, 09:22 PM

Hmmn still no reply? well in that case I may get this code done (or I may not) and post it for others to see but I am guessing this question was probably posted on multiple forums. Very unfortunate, sure glad I didn't waste my time on it yet.

babs · #5 07-14-2014, 09:03 AM

Sorry, I was off Friday and didn't check my email over the weekend. This isn't posted on any other forum though. I have attached an example of what I would be looking for in the output. I made a loop that basically copy and pastes, then deletes the line it came from. However, that takes a while to run through all the lines and I know there has to be a better way! I appreciate you taking the time to look at it!

excelledsoftware · #6 07-14-2014, 05:15 PM

Then I am in error here. I sincerely apologize for jumping to conclusions. I will write this code for you and post it soon. Again I am sorry please accept my apologies.

excelledsoftware · #7 07-14-2014, 06:42 PM

OK. Thanks for posting the result I actually had it all coded to column C and then I saw column D was the way you wanted to go. Now I have hard coded column D but we can always change that up if needed. This program works with the default sheet names so if you have changed those we will need to change it in the code as well. I ran a test on your sample sheet and it looks like it worked. Please save a back up copy before running as this code will process a sort on your original data. With your example everything ran fine but there could be bugs with a bigger data set. Give it a shot and let me know if you have any questions. Thanks for your patience.

Code:

Option Explicit
Sub ParseAgreements()
  'searches through all sorted records of a table
  'and exports the results in a 1 record per row
  'result.
  
  Dim EndRngRow As Long, CheckRow As Long
  Dim ResultRow As Long
  Dim FoundEndRow As Boolean
  Dim FindCol As Integer, StartRngRow As Integer, BegRow As Integer
  Dim Col As Integer
  Dim ValString As String, AgreementNum As String, ColData(11) As String
  Dim ws As Worksheet, rws As Worksheet
  Dim wb As Workbook
  
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1") 'worksheet with data.
    Set rws = wb.Worksheets("Sheet2") 'worksheet for result.
  
    StartRngRow = 2 'Change if your data starts below row 2
    ResultRow = 2
    BegRow = StartRngRow - 1
    On Error GoTo 0 'Put errors back to normal
    'Convert the found column to a string
    If Range("D" & StartRngRow - 1).Value <> "Agreement/Subs Num" Then
      MsgBox "The Agreement Sub column is not in D" & _
      StartRngRow - 1 & vbLf & _
      "This program is coded to work with column D" & vbLf & _
      "Program Ending"
      End
    End If
    
    'Set up the results headers
    rws.Range("A1:Z30000").ClearContents
    rws.Range("A1").Value = "Legacy Number"
    rws.Range("B1").Value = "Alternative Lease Number"
    rws.Range("C1").Value = "Agreement Number"
    rws.Range("D1").Value = "Agreement/Subs Num"
    rws.Range("E1").Value = "Property Status"
    rws.Range("F1").Value = "Full Lessor Name"
    rws.Range("G1").Value = "Immediate Predecessor"
    rws.Range("H1").Value = "Book"
    rws.Range("I1").Value = "Term Length (Months)"
    rws.Range("J1").Value = "Total Bonus Amount"
    rws.Range("K1").Value = "Lease Memo"

    CheckRow = StartRngRow
    ws.Activate
    ws.Range("D" & CheckRow).Select
    Selection.CurrentRegion.Select
    Selection.Sort Key1:=Range("D" & CheckRow), Order1:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    CheckRow = StartRngRow
    Do
      AgreementNum = ws.Range("D" & StartRngRow).Value
      FoundEndRow = False
        Do Until FoundEndRow = True
          If ws.Range("D" & CheckRow).Value <> AgreementNum Then
            EndRngRow = CheckRow - 1
            FoundEndRow = True
          End If
          If ws.Range("D" & CheckRow).Value = "" Then
            FoundEndRow = True 'end the loop
          End If
          CheckRow = CheckRow + 1
        Loop
        For CheckRow = StartRngRow To EndRngRow
          For Col = 1 To 11
            If ws.Cells(CheckRow, Col).Value <> "" Then
              ColData(Col) = ws.Cells(CheckRow, Col).Value
            End If
          Next Col
        Next CheckRow
        'export the results
        For Col = 1 To 11
          rws.Cells(ResultRow, Col).Value = ColData(Col)
        Next Col
        'get ready for the next batch
        For Col = 0 To 11
          ColData(Col) = ""
        Next Col
        ResultRow = ResultRow + 1
        StartRngRow = CheckRow
    Loop Until ws.Range("D" & CheckRow).Value = ""
    rws.Activate
     
End Sub

babs · #8 07-15-2014, 07:14 AM

Great! Thank you so much! This is a great help!

charlesdh · #9 07-15-2014, 10:24 AM

HI,

My 2 cents...I modified excelledsoftware. All I did was shorten the code by using an "Array". This is just another way to code.

Code:

Sub ParseAgreements()
  'searches through all sorted records of a table
  'and exports the results in a 1 record per row
  'result.
  
  Dim EndRngRow As Long, CheckRow As Long
  Dim ResultRow As Long
  Dim FoundEndRow As Boolean
  Dim FindCol As Integer, StartRngRow As Integer, BegRow As Integer
  Dim Col As Integer
  Dim ValString As String, AgreementNum As String, ColData(11) As String
  Dim ws As Worksheet, rws As Worksheet
  Dim wb As Workbook
  
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1") 'worksheet with data.
    Set rws = wb.Worksheets("Sheet2") 'worksheet for result.
  
    StartRngRow = 2 'Change if your data starts below row 2
    ResultRow = 2
    BegRow = StartRngRow - 1
    On Error GoTo 0 'Put errors back to normal
    'Convert the found column to a string
    If Range("D" & StartRngRow - 1).Value <> "Agreement/Subs Num" Then
      MsgBox "The Agreement Sub column is not in D" & _
      StartRngRow - 1 & vbLf & _
      "This program is coded to work with column D" & vbLf & _
      "Program Ending"
      End
    End If
    
    'Set up the results headers
    rws.Range("A1:Z30000").ClearContents
   '''' Modified '''
    rws.Range("A1:K1").Value = Array("Legacy Number", "Alternative Lease Number", _
        "Agreement Number", "Agreement/Subs Num", "Property Status", "Immediate Predecessor", "Book", "Term Length (Months)", "Total Bonus Amount", "Lease Memo")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    CheckRow = StartRngRow
    ws.Activate
    ws.Range("D" & CheckRow).Select
    Selection.CurrentRegion.Select
    Selection.Sort Key1:=Range("D" & CheckRow), Order1:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    CheckRow = StartRngRow
    Do
      AgreementNum = ws.Range("D" & StartRngRow).Value
      FoundEndRow = False
        Do Until FoundEndRow = True
          If ws.Range("D" & CheckRow).Value <> AgreementNum Then
            EndRngRow = CheckRow - 1
            FoundEndRow = True
          End If
          If ws.Range("D" & CheckRow).Value = "" Then
            FoundEndRow = True 'end the loop
          End If
          CheckRow = CheckRow + 1
        Loop
        For CheckRow = StartRngRow To EndRngRow
          For Col = 1 To 11
            If ws.Cells(CheckRow, Col).Value <> "" Then
              ColData(Col) = ws.Cells(CheckRow, Col).Value
            End If
          Next Col
        Next CheckRow
        'export the results
        For Col = 1 To 11
          rws.Cells(ResultRow, Col).Value = ColData(Col)
        Next Col
        'get ready for the next batch
        For Col = 0 To 11
          ColData(Col) = ""
        Next Col
        ResultRow = ResultRow + 1
        StartRngRow = CheckRow
    Loop Until ws.Range("D" & CheckRow).Value = ""
    rws.Activate
     
End Sub

excelledsoftware · #10 07-15-2014, 04:54 PM

Wow Charles! I didn't know you could use an array like that. I really like how it cleans it up. that will make so many of the tasks I do easier. I always thought you would have to loop through the cells with an array like that, but this works great! Thanks!!!

charlesdh · #11 07-15-2014, 04:59 PM

excelledsoftware,

I too learned from your post.

excelledsoftware · #12 07-15-2014, 05:00 PM

Awesome Just Awesome!!

BobBridges · #13 07-15-2014, 05:20 PM

I use arrays to populate ranges not so much because my program looks neater but because it requires a tiny fraction of the time. If we pretend it takes 15 seconds to fill in 5000 rows and 10 columns, it happens almost as fast as I can think about it if I fill up an array first and then put the array into a range.

<hijack>But there's something I've been thinking about for a while. My statement for populating from the array looks like this:

Code:

Range(ows.Cells(2, 1), ows.Cells(rz, 10)).Value = arr

But after looking at this I wonder whether it's possible to do it with other properties as well, for example:

Code:

Range(ows.Cells(2, 1), ows.Cells(rz, 10)).FormulaR1C1 = arr

This might allow me to do complex things with other than values. I've never tried it, but I give it about 60% that it'll work just fine.</hijack>

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Excel Multiple Rows Merged into Word (Vertical Format)	ats1025	Mail Merge	3	11-19-2013 02:21 PM
Add multiple rows to Excel 2010 table at cursor position	C J Squibb	Excel Programming	12	11-07-2013 07:35 AM
Excel Pivot - Do not display rows with zero value	patidallas22	Excel	1	03-08-2013 01:35 PM
Find Results in excel copy the rows to another sheet	khalidfazeli	Excel	2	02-06-2013 09:38 AM
Drag and drop rows in Excel	fireman0174	Excel	0	11-14-2011 05:26 AM