How to arrange cells like this?

http://i.imgur.com/U0cVdQk.png
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

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

Quote:

---

Originally Posted by Kenneth Hobson

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.

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

---

Quote:

---

Originally Posted by Kenneth Hobson

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)

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))

---

If you are looking for solution without code than this might help

Attachment 1927

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

---

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

---