user3178824
user3178824

Reputation: 11

Move a row to the end of another based on certain conditions

My worksheet has varying amounts of rows. Columns are from A to R and basically contain names and addresses. Under Client names contain Co-signers which can vary from none to say 10. I need to move the Co-signer (1) row to the end of the client row. If that client contains more than one Cosigner then the next Co-signer(2) row is to be moved to the end of Co-signer(1) information. I can get the first one to work but can not figure out how to loop thru the worksheet and get all of the Co-signers on the correct Client line. This is what I have so far. Example

CLIENT#   FIRST NAME   LAST NAME      DEBT_SSN        STREET                

00001     MICKEY       MOUSE          000-00-0000     Address Number 1              
          (CS) DONALD  DUCK           000-00-0001     Address Number 2              
00002     MINNIE       MOUSE          000-00-0002     Address Number 3              
          (CS) DAFFEY  DUCK           000-00-0003     Address Number 4              
          (CS) BARNIE  RUBBEL         000-00-0004     Address Number 5      

In this example the information for (CS) Donald Duck would be moved to Row 2 Columns S thru AI (CS) Daffey Duck would move to Row 4 Columns S thru AI. Then (CS) Barnie Rubbel would move to Row 4 Columns AJ to AZ.

Sub MOVECS()

Dim Rng As Range

Set Rng = Range("B2:B6000").Find(What:="*(CS)*", LookAt:=xlWhole, _
                                          LookIn:=xlValues)
Rng.Resize(1, 17).Cut Rows(1).End(xlDown).Offset(0, 18)

End Sub

I tried to add a "Nxt Rng" but that would take my last (CS) record and move it to the second row.

Upvotes: 1

Views: 795

Answers (1)

chrono
chrono

Reputation: 138

Here's my solution:

    Sub append_cs_to_end_of_rows()
        'once cs row is appended to end of client row, it deletes the source cs row
        r = 2
        num_columns = 17 'this is the number of columns in the cs rows. would need to add one to it to get the number of columns in the client rows.
        Do While Not IsEmpty(Range("b" & r))
            client_r = r
            r = r + 1
            cur_offset = num_columns
            Do While IsEmpty(Range("a" & r)) And Not IsEmpty(Range("b" & r))
                For c = 2 To 1 + num_columns
                    Cells(client_r, c + cur_offset).Value = Cells(r, c).Value
                Next c
                Rows(r).Delete shift:=xlUp
                cur_offset = cur_offset + num_columns
            Loop
        Loop
    End Sub

I avoided using copy/paste or cut since both of those require ranges, and it's hard to increment a column without a num_to_col function.

Note that there is a maximum number of columns, so you can't have too many cs for each client. If you stay under 900 per client, you should be ok (assuming you are using Office 2010 or higher).

Good luck.

Upvotes: 1

Related Questions