Solved

Excel VBA to copy row where 2 cells meet criteria

Posted on 2011-09-13
3
293 Views
Last Modified: 2012-08-14
I have 2 workbooks.
One is named "total parts" (has 1 sheet named Total Parts)
The other "PLGFP" (Has 3 sheets Sheet 1 ...)

I want to copy 2 types of data from the 'total parts' sheet which usually has a few thousand rows.

I need to look for any row in 'total parts' that has "OGM" in Col J and "YTD" in Col O and copy that row into Sheet 1 of PLGFP
Then
I need to look for any row in 'total parts' that has "TS CRU" in Col J and "YTD" in Col O and copy that row into Sheet 2 of PLGFP.

So I expect to have a few hundred rows in each Sheet 1 & 2  of book PLGFP,  which I will save and then perform some calculations
This will be a monthly automated macro and the number of rows will vary.

0
Comment
Question by:Mswetsky
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 4

Accepted Solution

by:
grogman earned 500 total points
ID: 36532009
Not exactly the prettiest macro I have ever written, but perhaps this will get you started. The code assumes that the macro is stored in the "PLGFP" file. The macro searches the currently open workbooks to find the "Total Parts" workbook, and if it is not already open, opens it for you. It then loops through the data copying and pasting to the appropriate sheets in the "PLGFP" file. The code is kind of slow (a result of actually selecting workbooks  and using the copy and paste methods). The code could be made faster by directly referencing the sheets and ranges and writing each cell's data, but the code would be much longer. Sample:

Sub Test()
    Dim PartsWB As Workbook
    Dim DestWB As Workbook
    Dim ArrWB As Workbook
    Dim ceLL As Range
    Dim boolWB As Boolean
    Dim partsRange As Range
    Dim partSheet As Worksheet
   
    boolWB = False
    Set DestWB = ThisWorkbook
    For Each ArrWB In Application.Workbooks
        If ArrWB.Name = "Total Parts.xlsx" Then
            Set PartsWB = ArrWB
            boolWB = True
        End If
    Next
    If boolWB = False Then
        Set PartsWB = Application.Workbooks.Open("Total Parts.xlsx")
    End If
    Set partSheet = PartsWB.Sheets("total parts")
    Set partsRange = partSheet.Range("J1:" & Range("J1").End(xlDown).Address)
    Application.ScreenUpdating = False
    For Each ceLL In partsRange
        PartsWB.Activate
        If ceLL.Value = "OGM" And ceLL.Offset(0, 5).Value = "YTD" Then
            ceLL.EntireRow.Copy
            DestWB.Activate
            DestWB.Sheets("Sheet1").Select
            Range("A1048576").End(xlUp).Offset(1, 0).Select
            ActiveCell.PasteSpecial xlPasteAllUsingSourceTheme
        End If
        If ceLL.Value = "TS CRU" And ceLL.Offset(0, 5).Value = "YTD" Then
            ceLL.EntireRow.Copy
            DestWB.Activate
            DestWB.Sheets("Sheet2").Select
            Range("A1048576").End(xlUp).Offset(1, 0).Select
            ActiveCell.PasteSpecial xlPasteAllUsingSourceTheme
        End If
    Next ceLL
    Application.ScreenUpdating = True
End Sub
0
 
LVL 1

Author Comment

by:Mswetsky
ID: 36532169
Wow this looks good. I will have this acting at the point when there is focus on the Total Parts book and the PL is open so this may be great to get me going.
0
 
LVL 1

Author Closing Comment

by:Mswetsky
ID: 36532576
As I mentioned I was at a point in a large macro that I was able to include the needed part of your macro with some amendments. Thank you very much for the prompt reply.
0

Featured Post

[Live Webinar] The Cloud Skills Gap

As Cloud technologies come of age, business leaders grapple with the impact it has on their team's skills and the gap associated with the use of a cloud platform.

Join experts from 451 Research and Concerto Cloud Services on July 27th where we will examine fact and fiction.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This article describes a serious pitfall that can happen when deleting shapes using VBA.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

635 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question