How to arrange cells like this?

robertdino

New Member
Joined
Jun 25, 2017
Messages
13
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. Help
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
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.
 
Upvote 0
Hia
How about this
Code:
Sub Bank()

    Dim UsdRws As Long
    Dim i As Long
    

    UsdRws = Cells.Find("*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For i = UsdRws To 2 Step -1
        If Range("A" & i) = "" Then
            Range("B" & i).Resize(1, 5).Copy Range("C" & i - 1)
            Rows(i).Delete
        End If
    Next i

End Sub
 
Upvote 0
Hia
How about this
Code:
Sub Bank()

    Dim UsdRws As Long
    Dim i As Long
    

    UsdRws = Cells.Find("*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For i = UsdRws To 2 Step -1
        If Range("A" & i) = "" Then
            Range("B" & i).Resize(1, 5).Copy Range("C" & i - 1)
            Rows(i).Delete
        End If
    Next i

End Sub

Faulty. This brought the lower half of the description from column B to column C and got mixed with other data (cheque numbers).

It must detect only blank cells in column A, then move the data (amounts, CR/DR etc.) in the rows below that cell one row up (merging the descriptions cell without a space in between) and delete the lower row.
 
Upvote 0
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG28Jul39
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Cells(1).CurrentRegion
[COLOR="Navy"]Set[/COLOR] Rng = Rng.Columns(1).SpecialCells(xlCellTypeBlanks)
[COLOR="Navy"]If[/COLOR] Not Rng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]For[/COLOR] ac = 1 To 4
           [COLOR="Navy"]If[/COLOR] Dn.Offset(-1, ac).Value = "" [COLOR="Navy"]Then[/COLOR]
                Dn.Offset(-1, ac).Value = Dn.Offset(, ac).Value
           [COLOR="Navy"]Else[/COLOR]
                Dn.Offset(-1, ac).Value = Dn.Offset(-1, ac).Value & " " & Dn.Offset(, ac).Value
           [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] ac
    [COLOR="Navy"]Next[/COLOR] Dn
Rng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
It would help if your screen shot was accurate as column C looks to be blank.
Try this
Code:
Sub Bank()

    Dim UsdRws As Long
    Dim i As Long
    

    UsdRws = Cells.Find("*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For i = UsdRws To 2 Step -1
        If Range("A" & i) = "" Then
            Range("B" & i - 1) = Range("B" & i - 1) & Range("B" & i)
            Range("C" & i).Resize(1, 4).Copy Range("C" & i - 1)
            Rows(i).Delete
        End If
    Next i

End Sub
 
Upvote 0
I see this on both macros
kZbNcAM.png


Macro from MickG worked but the row from which the data is sent above still remains. That needs to be deleted after the data shifts above.
 
Upvote 0
When you hit Debug what line of code does it highlight?

Also the code that MickG posted works on my test data
 
Upvote 0
When you hit Debug what line of code does it highlight?

Also the code that MickG posted works on my test data

Yes MickG's script works but it leaves the rows with empty dates intact.
Here is the line highlighted when pressing Debug on Mick's script

Code:
Dn.Offset(-1, ac).Value = Dn.Offset(-1, ac).Value & " " & Dn.Offset(, ac).Value
 
Upvote 0
If the code line is highlighted is obviously failed in some way , you would need to post your data or the part it fails on, in order to understand what's happening.
 
Upvote 0

Forum statistics

Threads
1,214,528
Messages
6,120,064
Members
448,941
Latest member
AlphaRino

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top