Results 1 to 4 of 4

Thread: opying into cells if particular criteria is met

  1. #1
    New Member
    Join Date
    Sep 2018
    Location
    Abu Dhabi
    Posts
    16
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default opying into cells if particular criteria is met

    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
    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
    2 17-10-19 OTHER FIXED DATA John 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

  2. #2
    Board Regular James006's Avatar
    Join Date
    Apr 2009
    Posts
    3,587
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    1 Thread(s)

    Default Re: opying into cells if particular criteria is met

    Hello,

    You should take a look at AutoFilter ...

    Hope this will help

  3. #3
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,299
    Post Thanks / Like
    Mentioned
    95 Post(s)
    Tagged
    5 Thread(s)

    Default Re: opying into cells if particular criteria is met

    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 by mumps; Oct 20th, 2019 at 10:02 AM.
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  4. #4
    New Member
    Join Date
    Sep 2018
    Location
    Abu Dhabi
    Posts
    16
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: opying into cells if particular criteria is met

    Quote Originally Posted by mumps View Post
    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.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •