opying into cells if particular criteria is met

Mazbuka

New Member
Joined
Sep 23, 2018
Messages
17
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>
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

James006

Well-known Member
Joined
Apr 4, 2009
Messages
3,680
Hello,

You should take a look at AutoFilter ...

Hope this will help
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238
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:

Mazbuka

New Member
Joined
Sep 23, 2018
Messages
17
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,328
Messages
5,624,036
Members
416,007
Latest member
csf

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
Top