Results 1 to 9 of 9

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
    Member
    Join Date
    May 2013
    Posts
    31
    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...

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40597&p=314054#p314054
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313971#p313971
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313909#p313909
    https://www.eileenslounge.com/viewtopic.php?f=27&t=40574&p=313879#p313879
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313859#p313859
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313855#p313855
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313848#p313848
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313843#p313843
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313792#p313792
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313771#p313771
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313767#p313767
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313746#p313746
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313744#p313744
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40560&p=313741#p313741
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313622#p313622
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313575#p313575
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313573#p313573
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313563#p313563
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=313555#p313555
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533
    https://www.eileenslounge.com/viewtopic.php?f=39&t=40265&p=313468#p313468
    https://www.eileenslounge.com/viewtopic.php?f=42&t=40505&p=313411#p313411
    https://www.eileenslounge.com/viewtopic.php?f=32&t=40473&p=313384#p313384
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313382#p313382
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313380#p313380
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40501&p=313378#p313378
    https://www.eileenslounge.com/viewtopic.php?f=32&t=40473&p=313305#p313305
    https://www.eileenslounge.com/viewtopic.php?f=44&t=40455&p=313035#p313035
    https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312889#p312889
    https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312886#p312886
    https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312752#p312752
    https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312734#p312734
    https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312727#p312727
    https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312724#p312724
    https://www.eileenslounge.com/viewtopic.php?f=44&t=40374&p=312535#p312535
    https://www.eileenslounge.com/viewtopic.php?p=312533#p312533
    https://www.eileenslounge.com/viewtopic.php?f=44&t=40373&p=312499#p312499
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 03-01-2024 at 02:25 PM.

  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
    Member
    Join Date
    May 2013
    Posts
    31
    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,123
    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

  8. #8
    Member
    Join Date
    May 2013
    Posts
    31
    Rep Power
    0
    Change that one line as Admin showed or this way. I did not catch that as I only tested using your example.

    I did not see a problem with column F. I did not see a Dr in your example.

    Attaching a short example file is one of the better ways to help us help you.

    Code:
    Sub MoveRowsUp()
      Dim r As Range, r1 As Range, r2 As Range, v, i As Long
      
      Set r = Range("A1", Cells(Rows.Count, "A").End(xlUp).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

  9. #9
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    13
    or

    Code:
    Sub M_snb()
      sn=cells(1).currentregion
    
      for j=2 to ubound(sn)
        sn(j,1)=sn(j-1,1)
        sn((j,2)=sn(j-1,2) & " " & sn(j,2)
        sn((j-1,1)=""
        sn(j-1,2)=""
      next
    
      with sheets.add
        .cells(1).resize(j,ubound(sn,2))=sn
        .columns(1).specialcells(4).entirerow.delete
      end with
    End Sub
    Last edited by snb; 09-04-2017 at 11:37 AM.

Similar Threads

  1. Replies: 4
    Last Post: 08-20-2013, 06:28 PM
  2. Replies: 13
    Last Post: 06-10-2013, 09:05 AM
  3. Replies: 2
    Last Post: 09-24-2012, 11:19 PM
  4. Arrange the data by year and format.
    By pesteness in forum Excel Help
    Replies: 15
    Last Post: 08-19-2012, 08:54 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
  •