opying into cells if particular criteria is met

Mazbuka

New Member
Joined
Sep 23, 2018
Messages
23
Office Version
  1. 365
Platform
  1. Windows
I have an excel journal template that I want completed from a cashbook type source...I'll show a simple example:

Say this is my cashbook



A B C D
1 DATE DETAIL AMOUNT CASH/CHECK
2 17-10-19 John 1000 CASH
3 17-10-19 Joan 1200 CASH
4 17-10-19 Fred 1500 CHECK
5 17-10-19 Pat 800 CASH
6 17-10-19 Mary 900 CHECK
7 17-10-19 Steve 750 CASH

<colgroup><col span="4"><col><col span="3"><col></colgroup><tbody>
</tbody>

<colgroup><col span="4"><col><col span="3"><col></colgroup><tbody>
</tbody>
I need relevant cells copied into the cash journal below

If D2 above = "cash", copy A2, B2, C2 & D2 above into A2, C2, D2 & E2 below respectively.

However if D2 above = "check" then Look at D3 above, if that's = "cash" copy from row 3 above into row 2 below, if it's ="check" then disregard and look at D4 & so on.

End result will look like this.


A B C C D E
1 DATE REFERENCE DETAIL DOC NUM AMOUNT CASH/CHECK
217-10-19OTHER FIXED DATAJohn OTHER FIXED DATA 1000 CASH
3 17-10-19 OTHER FIXED DATA Joan OTHER FIXED DATA 1200 CASH
4 17-10-19 OTHER FIXED DATA Pat OTHER FIXED DATA 800 CASH
5 17-10-19 OTHER FIXED DATA Steve OTHER FIXED DATA 750 CASH

<colgroup><col><col><col><col><col><col><col><col><col><col><col span="2"><col></colgroup><tbody>
</tbody>

<colgroup><col span="12"><col></colgroup><tbody>
</tbody>
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Hello,

You should take a look at AutoFilter ...

Hope this will help
 
Upvote 0
Assuming your cashbook and cash journal are in two separate sheets in the same workbook and are named "Cashbook" and "Cash Journal" respectively, try this macro:
Code:
Sub copyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("Cashbook")
    Set desWS = ThisWorkbook.Sheets("Cash Journal")
    Dim LastRow As Long, header As Range, fnd As Range
    LastRow = srcWS.Range("A" & srcWS.Rows.Count).End(xlUp).Row
    With srcWS.Cells(1, 1).CurrentRegion
        .AutoFilter 4, "CASH"
        With srcWS
            For Each header In .Range("A1:D1")
                Set fnd = desWS.Rows(1).Find(header, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    .Cells(2, header.Column).Resize(LastRow - 1).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(desWS.Rows.Count, fnd.Column).End(xlUp).Offset(1, 0)
                End If
            Next header
        End With
    End With
    srcWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Solution
Assuming your cashbook and cash journal are in two separate sheets in the same workbook and are named "Cashbook" and "Cash Journal" respectively, try this macro:
Code:
Sub copyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("Cashbook")
    Set desWS = ThisWorkbook.Sheets("Cash Journal")
    Dim LastRow As Long, header As Range, fnd As Range
    LastRow = srcWS.Range("A" & srcWS.Rows.Count).End(xlUp).Row
    With srcWS.Cells(1, 1).CurrentRegion
        .AutoFilter 4, "CASH"
        With srcWS
            For Each header In .Range("A1:D1")
                Set fnd = desWS.Rows(1).Find(header, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    .Cells(2, header.Column).Resize(LastRow - 1).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(desWS.Rows.Count, fnd.Column).End(xlUp).Offset(1, 0)
                End If
            Next header
        End With
    End With
    srcWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub


Thanks very much...I'll play around with this get an understanding of it.
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,924
Members
448,533
Latest member
thietbibeboiwasaco

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