Solved

Excel VBA to copy row where 2 cells meet criteria

Posted on 2011-09-13
3
288 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
  • 2
3 Comments
 
LVL 4

Accepted Solution

by:
grogman earned 500 total points
Comment Utility
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
Comment Utility
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
Comment Utility
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

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

What is a Form List Box? (skip if you know this) The forms List Box is the alternative to the ActiveX list box. If you are using excel 2007, you first make sure you have a developer tab (click the Orb)->"Excel Options"->Popular->"Show Developer tab…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

728 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now