Copy Data based on two criteria

HowardC · Jun 9th 2017

have data that has been imported on sheet "Data"

I need to copy data as follows to sheet "Stock received"

1) Where COL I contains RS and Col H does not contain "not received", then I need Col B:H copied to sheet Stock Received into Row 4 onwards
2) Where COL I contains NR and Col H does not contain "not received", then I need Col B:H copied to sheet Stock Received into Row 21 onwards

Your assistance in this regard is most appreciated

I have also posted two days ago on http://windowssecrets.com/foru…ata-based-on-two-criteria

**Trebor76** · Jun 9th 2017

Re: Copy Data based on two criteria

Quote

I have also posted two days ago on http://windowssecrets.com/forums/sho...n-two-criteria

And here

**Trebor76** · Jun 9th 2017

Re: Copy Data based on two criteria

Try this:

Code

Option Explicit
Sub Macro2()


    Dim lngMyRow    As Long
    Dim lngLastRow  As Long
    Dim lngPasteRow As Long
    Dim wsSource    As Worksheet
    Dim wsOutput    As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSource = Sheets("Data")
    Set wsOutput = Sheets("Stock Received")
    
    lngLastRow = wsSource.Range("B:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For lngMyRow = 2 To lngLastRow
        If StrConv(wsSource.Range("I" & lngMyRow), vbUpperCase) = "RS" And StrConv(wsSource.Range("H" & lngMyRow), vbProperCase) <> "Not Received" Then
            lngPasteRow = 4
            'Find the next available row from Row 4 to copy in data
            Do Until Len(wsOutput.Range("B" & lngPasteRow)) = 0
                lngPasteRow = lngPasteRow + 1
            Loop
            'Copy data
            wsSource.Range("B" & lngMyRow & ":H" & lngMyRow).Copy Destination:=wsOutput.Range("B" & lngPasteRow)
        ElseIf StrConv(wsSource.Range("I" & lngMyRow), vbUpperCase) = "NR" And StrConv(wsSource.Range("H" & lngMyRow), vbProperCase) <> "Not Received" Then
            lngPasteRow = 21
            'Find the next available row from Row 21 to copy in data
            Do Until Len(wsOutput.Range("B" & lngPasteRow)) = 0
                lngPasteRow = lngPasteRow + 1
            Loop
            'Copy data
            wsSource.Range("B" & lngMyRow & ":H" & lngMyRow).Copy Destination:=wsOutput.Range("B" & lngPasteRow)
        End If        
    Next lngMyRow
    
    Application.ScreenUpdating = True
    
End Sub

Display More

Just note that if the first block (i.e. Code RS on the Stock Received tab) gets filled the pasting of the data from then on will be out of sync.

Regards,

Robert

HowardC · Jun 9th 2017

Re: Copy Data based on two criteria

Thanks for the help, Robert

Will test & let you know the outcome

HowardC · Jun 9th 2017

Re: Copy Data based on two criteria

Have Tested Code & it works perfectly

If my source sheets consisted of several sheet,s How do change Set wsSource = Sheets("Data") to incorporate these ? for eg sheets "Data", "Data1", "Data2", "Data3"

**Trebor76** · Jun 9th 2017

Re: Copy Data based on two criteria

Try this:

Code

Option Explicit
Sub Macro2()
     
    Dim lngMyRow    As Long
    Dim lngLastRow  As Long
    Dim lngPasteRow As Long
    Dim varMyTab    As Variant
    Dim wsSource    As Worksheet
    Dim wsOutput    As Worksheet
     
    Application.ScreenUpdating = False
    
    Set wsOutput = Sheets("Stock Received")
    
    For Each varMyTab In Array("Data", "Data1", "Data2", "Data3")
        
        Set wsSource = Sheets(CStr(varMyTab))
        
        lngLastRow = wsSource.Range("B:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
         
        For lngMyRow = 2 To lngLastRow
            If StrConv(wsSource.Range("I" & lngMyRow), vbUpperCase) = "RS" And StrConv(wsSource.Range("H" & lngMyRow), vbProperCase) <> "Not Received" Then
                lngPasteRow = 4
                 'Find the next available row from Row 4 to copy in data
                Do Until Len(wsOutput.Range("B" & lngPasteRow)) = 0
                    lngPasteRow = lngPasteRow + 1
                Loop
                 'Copy data
                wsSource.Range("B" & lngMyRow & ":H" & lngMyRow).Copy Destination:=wsOutput.Range("B" & lngPasteRow)
            ElseIf StrConv(wsSource.Range("I" & lngMyRow), vbUpperCase) = "NR" And StrConv(wsSource.Range("H" & lngMyRow), vbProperCase) <> "Not Received" Then
                lngPasteRow = 21
                 'Find the next available row from Row 21 to copy in data
                Do Until Len(wsOutput.Range("B" & lngPasteRow)) = 0
                    lngPasteRow = lngPasteRow + 1
                Loop
                 'Copy data
                wsSource.Range("B" & lngMyRow & ":H" & lngMyRow).Copy Destination:=wsOutput.Range("B" & lngPasteRow)
            End If
        Next lngMyRow
    
    Next varMyTab
     
    Application.ScreenUpdating = True
     
End Sub

Display More

kaffal · Jun 11th 2017

Re: Copy Data based on two criteria

Hi, I had a worksheet something similar to the above request. If I had several Destination worksheet labelled under Code instead. the code will copy and paste to the worksheet named after the value in cell "Code". The place to copy to will be the row below the cell in column A equal to "Insert". However the code will insert a new row before paste over. Appreciate someone can help.

**Trebor76** · Jun 11th 2017

Re: Copy Data based on two criteria

Hi kaffal,

We're glad to have you here at Ozgrid, however, to get the most benefit from this forum please take the time to read over the forum rules.

Thread hijacking is a violation of the forum rules.

ALWAYS start a new thread for your questions with a link back to this thread if you think it will help.

Robert

HowardC · Jul 10th 2017

Re: Copy Data based on two criteria

Hi Robert

You kindly assisted my a while back with code to copy data

I have amended the code to paste data on sheet "Recon Items" from row 10 onwards where "RS" and "'Not rec" appears on sheets STAT1 in Col AP (RS) and col V "Not REC"

the data copies perfectly , except that when running the macro the file opens & I then click cancel

Kindly amend code so that this does not happen

Code

Sub Copy Data()
     
    Dim lngMyRow    As Long
    Dim lngLastRow  As Long
    Dim lngPasteRow As Long
    Dim varMyTab    As Variant
    Dim wsSource    As Worksheet
    Dim wsOutput    As Worksheet
     
    Application.ScreenUpdating = False
     
    Set wsOutput = Sheets("Recon Items")
     
    For Each varMyTab In Array("STAT1", "STAT2", "STAT3", "STAT4")
         
        Set wsSource = Sheets(CStr(varMyTab))
         
        lngLastRow = wsSource.Range("B:AP").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
         
        For lngMyRow = 10 To lngLastRow
            If StrConv(wsSource.Range("AP" & lngMyRow), vbUpperCase) = "RS" And StrConv(wsSource.Range("V" & lngMyRow), vbProperCase) <> "Not Rec*" Then
                lngPasteRow = 10
                 'Find the next available row from Row 10 to copy in data
                Do Until Len(wsOutput.Range("B" & lngPasteRow)) = 0
                    lngPasteRow = lngPasteRow + 1
                Loop
                
                wsSource.Range("B" & lngMyRow & ":AP" & lngMyRow).Copy Destination:=wsOutput.Range("B" & lngPasteRow)
           
                Do Until Len(wsOutput.Range("B" & lngPasteRow)) = 0
                    lngPasteRow = lngPasteRow + 1
                Loop
              
            End If
        Next lngMyRow
         
    Next varMyTab
     
    Application.ScreenUpdating = True
     
End Sub

Display More

**Trebor76** · Jul 10th 2017

Re: Copy Data based on two criteria

Quote

except that when running the macro the file opens & I then click cancel

Can you show me which line that is happening on as I cannot see any code that is opening a file :confused:

HowardC · Jul 10th 2017

Re: Copy Data based on two criteria

I'm have run F8 to see if I can determine line of code where I asks me to select file, but It does not do this

As soon As I run the macro, I need to select the workbook

**Trebor76** · Jul 10th 2017

Re: Copy Data based on two criteria

Quote

I'm have run F8 to see if I can determine line of code where I asks me to select file, but It does not do this
As soon As I run the macro, I need to select the workbook

I'm afraid I can't help as I can't replicate the error and I don't understand how you can step through the macro (F8) and it works fine but not when you run it :confused:

HowardC · Jul 11th 2017

Re: Copy Data based on two criteria

Just to let you know that I run the macro on my Laptop this morning and the code runs perfectly. Not sure why I had to select the workbook from folder when running the macro on my PC at the office- must be some sort of gremlim that kept in. Anyway it is working and thanks for all your input

Copy Data based on two criteria

Participate now!

Share