Results 1 to 7 of 7

Thread: How to arrange cells like this?

  1. #1
    Junior Member
    Join Date
    Jul 2017
    Posts
    3
    Rep Power
    0

    How to arrange cells like this?


    I have a bank statement with some entries like this.
    As you can see, the description is split vertically into 2 cells in 2 different rows and the amounts/credit or debit come in the lower row as well.

    I need a macro that will detect all cells with missing dates in column A, then shift all data in that correspondent row to the row above and then delete the blank row when the data is shifted up so each transaction in the sheet comes in 1 row with all details in the same row.

    Help
    Attached Images Attached Images

  2. #2
    Junior Member
    Join Date
    May 2013
    Posts
    23
    Rep Power
    0
    Welcome to the forum!

    What happens to the cells with data already in them like B1 and B2? Delete B2, or combine B1 and B2 delimited by a space character, or...

  3. #3
    Junior Member
    Join Date
    Jul 2017
    Posts
    3
    Rep Power
    0
    Quote Originally Posted by Kenneth Hobson View Post
    Welcome to the forum!

    What happens to the cells with data already in them like B1 and B2? Delete B2, or combine B1 and B2 delimited by a space character, or...
    Data in B2 should be combined with data in B1 with no space in between.
    Then row 2 should be removed and lower row takes its place.

  4. #4
    Junior Member
    Join Date
    May 2013
    Posts
    23
    Rep Power
    0
    Place code in a Module. Run for active sheet. Be sure to run on a backup copy as usual when testing copy.

    Code:
    Sub MoveRowsUp()
      Dim r As Range, r1 As Range, r2 As Range, v, i As Long
      
      Set r = Range("A1", Range("A1").End(xlDown).Offset(1))
      
      Application.EnableEvents = False
      Application.DisplayAlerts = False
      Application.Calculation = xlCalculationManual
      Application.ScreenUpdating = False
      
      On Error GoTo EndSub
      For i = r.Rows.Count To 1 Step -1
        Set r1 = Cells(i, "A")
        Set r2 = Cells(i - 1, "A")
        If r1.Value = "" And r2.Value > 0 Then
          'Concatenate column B values
          v = r2.Offset(, 1).Value & r1.Offset(, 1).Value
          Range("B" & i & ":F" & i).Cut Destination:=Range("B" & i - 1 & ":F" & i)
          Rows(i).Delete Shift:=xlUp
          Cells(i - 1, "B").Value = v 'Add concatenated column B value back.
        End If
      Next i
      
    EndSub:
      Application.EnableEvents = True
      Application.DisplayAlerts = True
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
    End Sub

  5. #5
    Junior Member
    Join Date
    Jul 2017
    Posts
    3
    Rep Power
    0
    Quote Originally Posted by Kenneth Hobson View Post
    Place code in a Module. Run for active sheet. Be sure to run on a backup copy as usual when testing copy.

    Code:
    Sub MoveRowsUp()
      Dim r As Range, r1 As Range, r2 As Range, v, i As Long
      
      Set r = Range("A1", Range("A1").End(xlDown).Offset(1))
      
      Application.EnableEvents = False
      Application.DisplayAlerts = False
      Application.Calculation = xlCalculationManual
      Application.ScreenUpdating = False
      
      On Error GoTo EndSub
      For i = r.Rows.Count To 1 Step -1
        Set r1 = Cells(i, "A")
        Set r2 = Cells(i - 1, "A")
        If r1.Value = "" And r2.Value > 0 Then
          'Concatenate column B values
          v = r2.Offset(, 1).Value & r1.Offset(, 1).Value
          Range("B" & i & ":F" & i).Cut Destination:=Range("B" & i - 1 & ":F" & i)
          Rows(i).Delete Shift:=xlUp
          Cells(i - 1, "B").Value = v 'Add concatenated column B value back.
        End If
      Next i
      
    EndSub:
      Application.EnableEvents = True
      Application.DisplayAlerts = True
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
    End Sub
    Works but only once for 1 row. Should do the whole sheet in a single go.
    Also the column F becomes blank (Cr/Dr goes away)

  6. #6
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,086
    Rep Power
    10
    replace

    Code:
    Set r = Range("A1", Range("A1").End(xlDown).Offset(1))
    with

    Code:
    Set r = Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(1))
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  7. #7
    Junior Member
    Join Date
    Feb 2015
    Posts
    6
    Rep Power
    0
    If you are looking for solution without code than this might help

    Sample.xlsx

Similar Threads

  1. Replies: 4
    Last Post: 08-20-2013, 06:58 PM
  2. Replies: 13
    Last Post: 06-10-2013, 09:35 AM
  3. Replies: 2
    Last Post: 09-24-2012, 11:49 PM
  4. Arrange the data by year and format.
    By pesteness in forum Excel Help
    Replies: 15
    Last Post: 08-19-2012, 09:24 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •