Results 1 to 8 of 8

Thread: Copy paste data based on criteria

  1. #1
    Member
    Join Date
    Aug 2013
    Posts
    59
    Rep Power
    12

    Copy paste data based on criteria

    For the same database, I've one more query, If i could automate that through macro. Though it is on different subject, since you are here, I'm taking liberty to avoid creating new thread.

    Say, in a sheet1, I've 6000+ row data, which i could ditinguish on two words contains in Column E, Which is either "XX", or "YY".

    I've to select all rows where cell content in column E has word "XX" (without quote) and select, copy that and paste in say sheet2 from A1, and then again comeback to Sheet1, and select all those rowas where cell content in Column E has word "YY" (without quote) and select, copy and paste in Sheet3, cell A1.

    While i tried with auto filter, at first hit, i am able to do this, as on few occassion word "xx" starts from row 2 itself, but when it starts from other row number, i am not able to select rest of the rows having word yy and do the work.

    Any small procedure to do this? I am searching the forum, may be, similar query would have been resolved!

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    Come up with the macro you have now.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  3. #3
    Member
    Join Date
    Aug 2013
    Posts
    59
    Rep Power
    12
    Through Google search, I found solution to my second query from this thread on another forum,

    Copy entire row if Cell(Cells) in row contains specific string

  4. #4
    Member littleiitin's Avatar
    Join Date
    Aug 2011
    Posts
    90
    Rep Power
    14
    Try this

    Code:
    Sub FilterData()
        
        Dim rngFilterRange  As Range
        Dim rngToCopy       As Range
        With Sheet1
            If .AutoFilterMode = True Then .AutoFilterMode = False
            
            Set rngFilterRange = .Range("A1").CurrentRegion
        '=============For xx==================================
            '====Applied Filter for Words contains XX ===========
            rngFilterRange.AutoFilter Field:=5, Criteria1:="=*xx*", Operator:=xlAnd
            
            '=====Creating Range to Copy ========
            Set rngToCopy = .Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible)
            '=====Copying Range =================
            rngToCopy.Copy
            '=====Pasting Data in Sheet 2 ==================
            Sheet2.Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
            
            
            
        '=============For yy==================================
            If .AutoFilterMode = True Then .AutoFilterMode = False
            '====Applied Filter for Words contains yy ===========
            rngFilterRange.AutoFilter Field:=5, Criteria1:="=*yy*", Operator:=xlAnd
            
            '=====Creating Range to Copy ========
            Set rngToCopy = .Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible)
            '=====Copying Range =================
            rngToCopy.Copy
            '=====Pasting Data in Sheet 3 ==================
            Sheet3.Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
            
            If .AutoFilterMode = True Then .AutoFilterMode = False
            
        End With
    End Sub

  5. #5
    Member
    Join Date
    Aug 2013
    Posts
    59
    Rep Power
    12
    @ Thanks for your above code, littletin.

    Last question, Is there any smartway to filter Date (read from Cell O2), and delete all rows within range A:O, including Cell O2, where similar date is found in Column O?

  6. #6
    Member
    Join Date
    Aug 2013
    Posts
    59
    Rep Power
    12
    My Current code is as under,

    Code:
    Sub deleterow()
    Dim dt As Date, x As Date
    
    Sheets("raw").Select
    x = Range("O2")
    
    [O:O].AutoFilter Field:=1, Criteria1:=x 'filters on column O where cell contains some date
    With ActiveSheet.AutoFilter.Range
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
    End With '
    
    ActiveSheet.AutoFilterMode = False 'turns off autofilter
    End Sub
    The issue,

    1) It filters date but does not recognise the date format as dd-mmm-yy (filter mode shows criteria equals m/d/yyyy)
    2) When I select date manually, rest of the code gets executed to delete rows, but still it leaves first row as undeleted where the criteria is also matched.

    What modification, do i need to make, and in which part of the macro?

  7. #7
    Member littleiitin's Avatar
    Join Date
    Aug 2011
    Posts
    90
    Rep Power
    14
    Try This:

    Code:
    Sub FindandDelete()
        
        Dim rngMakeRange        As Range
        Dim lngCnt              As Long
        Dim rngFindNext         As Range
        Dim rngCheck            As Range
        Dim dicRow              As Object
        
        Set dicRow = CreateObject("Scripting.Dictionary")
        With Sheet1
            Set rngFindNext = .Range("A:O").Find(.Range("O2").Value)
            Set rngMakeRange = rngFindNext
            dicRow.Add rngFindNext.Row, 1
            Do Until Not Intersect(rngMakeRange, .Range("A:O").FindNext(rngFindNext)) Is Nothing
                Set rngFindNext = .Range("A:O").FindNext(rngFindNext)
                If Not dicRow.Exists(rngFindNext.Row) Then
                    dicRow.Add rngFindNext.Row, 1
                    If rngMakeRange Is Nothing Then
                        Set rngMakeRange = rngFindNext
                    Else
                        Set rngMakeRange = Union(rngMakeRange, rngFindNext)
                    End If
                End If
            Loop
        End With
        rngMakeRange.EntireRow.Delete
        
    End Sub

  8. #8
    Member
    Join Date
    Aug 2013
    Posts
    59
    Rep Power
    12
    Thanks, but after execution, nothing happens, sheet data remains as it was before.

Similar Threads

  1. Replies: 4
    Last Post: 12-12-2013, 06:16 PM
  2. Replies: 8
    Last Post: 10-31-2013, 12:38 AM
  3. Replies: 2
    Last Post: 09-18-2013, 12:30 AM
  4. Replies: 9
    Last Post: 07-02-2013, 10:02 PM
  5. Trapping Copy To Range Before Copy/Cut Paste
    By Rasm in forum Excel Help
    Replies: 4
    Last Post: 04-07-2011, 07:48 PM

Posting Permissions

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