line item extractor

Ok, so here is the deal. I have multiple excel files with 20-30 sheets per file. These files are full of data, account numbers etc etc. I have been trying to build a macro that can crawl through every sheet and extract line item. For example, in the attached worksheet, if i want to extract the rows for account number 251122812 from all sheets, and put it in a new file or maybe a sheet within the main file, how can i do it? Please help me out, there are thousands of line items that need to be extracted, and its simply a tedious work to do it manually....

Any help will be appreciated and remembered

We need to clarify what you're really after.

1) Do you want to create new worksheet for all items matching single account number?

2) If yes, is this worksheet in a new master workbook or inside one of your many workbooks?

3) Are we consolidating the info in all sheets in ONE workbook (already open) or do you want to sift through an entire folder on your hard drive and pull in all the data for a single account number?

4) If sifting through an entire folder, your data does not include dates or any identifying information. Would you need to add the workbook name and/or sheet name each bit of data came from, or no?

===============
I would think possibly something like this:

1) In a Master workbook, prompt user to enter an account number
2) If a worksheet already exists for that account number, clear the sheet and get ready to enter new data, if not then create this new sheet
3) Prompt user to select a folder to sift through all files
4) After folder is selected open each file one at a time
5) In each file opened, cycle through ALL sheets and filter for data in column A matching the account number, copy it to the Master-Acct # sheet adding workbook names and sheet names to each row of copied data.

Is that about right?

Got a sample workbook with the exact layout and a good set of sample data?

Click GO ADVANCED and use the paperclip icon to post up your workbook.

Last question, will the workbook to search already be open? I envision the beginning of the macro prompting you to enter an Account number, then prompting you to select a workbook from the hard drive. The macro opens the wb, pulls all the data, closes that workbook, then saves this new wb and leaves it open for you to review.

Put this into an empty workbook to run from, it won't be in the workbook created, nor needs to be in the workbooks being searched.

Option Explicit

Sub ConsolidateInfoFromSheets()
'JBeaucaire (5/7/2010)
'Search all sheets in a workbook for one account
'and merge rows into one summary sheet (stacked)
Dim cs As Worksheet, ws As Worksheet, wbData As Workbook
Dim LR As Long, NR As Long, AcctCol As Long
Dim sName As Boolean, fClose As Boolean
Dim fName As String, AcctColStr As String, AcctNum As Double
Application.ScreenUpdating = False

'String that will identify the account numbers in workbook
'sheets without this text string will be skipped
    AcctColStr = "Account Number"

'Prompt for an account number, activecell will be the default offered
    AcctNum = Application.InputBox("Enter the Account Number to consolidate", _
        "Account Number", IIf(IsNumeric(ActiveCell), ActiveCell, 0), Type:=1)
    If AcctNum = 0 Then Exit Sub

'Prompt for the workbook to open
    If MsgBox("Use the current activeworkbook?" & vbLf & vbLf & _
        "YES - current workbook will be consolidated" & vbLf & _
        "NO  - you will be allowed to select a workbook", vbYesNo) = vbNo Then
        
        fName = Application.GetOpenFilename("Microsoft Office Excel Files (.xls),.xls")
        If fName = "False" Then Exit Sub
        Set wbData = Workbooks.Open(fName)
        fClose = True
    End If

'Add consolidation sheet if needed
    If Not Evaluate("ISREF(Consolidated!A1)") Then _
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Consolidated"

'Option to add sheet names to consolidation report
    sName = MsgBox("Add sheet names to consolidation report?", vbYesNo + vbQuestion) = vbYes

'Setup
    Set cs = Sheets("Consolidated")
    cs.Cells.ClearContents
    NR = 1
    On Error GoTo Next1

'Process each data sheet in selected workbook
    For Each ws In Worksheets
        If ws.Name <> "Consolidated" Then
            AcctCol = ws.Cells.Find(AcctColStr, After:=ws.Range("A" & ws.Rows.Count), _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, _
                SearchFormat:=False).Column
            ws.Columns(AcctCol).AutoFilter Field:=1, Criteria1:=AcctNum
            LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            If LR > 1 Then  'make sure there is at least one row to copy
                'find range to copy
                If NR = 1 Then      'copy with titles in row 1
                    ws.Range("A1:Z" & LR).Copy
                Else                'copy without titles
                    ws.Range("A2:Z" & LR).Copy
                End If
            
                If sName Then       'paste and add sheet names if required
                    cs.Range("B" & NR).PasteSpecial xlPasteValues
                    cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = ws.Name
                Else
                    cs.Range("A" & NR).PasteSpecial xlPasteValues
                End If
                
                NR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row + 1
            End If
            ws.AutoFilterMode = False
        End If
Next1:
    Next ws
    
'Cleanup and save
    cs.Move
    If fClose Then wbData.Close False
    If sName Then [A1] = "Sheet"
    Rows(1).Font.Bold = True
    Cells.Columns.AutoFit
    ActiveWorkbook.SaveAs AcctNum & Format(Date, "  MM-DD-YY"), xlNormal
    Application.ScreenUpdating = True
End Sub

If you already have the workbook open that you want to search/consolidate, then click on the account number and run the macro. Whatever the Activecell is will be used to offer you an account number verification, just press ENTER to accept it and YES to confirm this is the workbook you want to search.

If this ISN'T the workbook, just enter the correct Account Number and then say NO to the workbook question, it will let you select another workbook.

The workbook created will be saved with the account number and the current date.


This is based on the macro ConsolidateSheets from my site here:

Sheets to 1 Sheet

How/Where to install the macro:

1. Open a new Empty workbook
2. Get into VB Editor (Press Alt+F11)
3. Insert a new module (Insert > Module)
4. Copy and Paste in your code (given above)
5. Get out of VBA (Press Alt+Q)
6. Save as a macro-enabled workbook

The macro is installed and ready to use.

===========
How to use the macro:

1) With this workbook open, enter an account number into a cell and click it to make sure it is the active cell
2) Press Alt-F8 and select ConsolidateInfoFromSheets from the macro list.
3) Confirm this the account number you want, or enter a new one in the popup and press OK
4) If the current active workbook is not the workbook to search, click NO and select the workbook from your harddrive

THe script is awesome. I am so glad i am getting help from you. there is a problem though. When i enter accoutn number and press 'OK', it asks me to add workbooks, i search for workbook and then press OK. i get error code 91.


Runtime error 91

After Debugging:This section is highlighted in Yellow

   AcctCol = ws.Cells.Find(AcctColStr, After:=ws.Range("A" & Rows.Count), _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, _
                SearchFormat:=False).Column

Please edit your post to add CODE tags.

In my signature is an example of the [code] and [/code] tags you need to put around the code you posted above. EDIT your prior post and add them. The result will look like my post #8.

The hidden sheet SQL-SETTINGS caused a hiccup. I corrected the code above in post #8 (added a ws reference to help overcome the problem. I tested it an it's working now. Try it again.

And when you debug, which line of code is highlighted?

That line of code is the macro trying to spot the "Account Number" string on the currently evaluated sheet. It should simply fail and move on, which it does on the visible sheets. I still think you're getting hung up on the hidden worksheet, though it isn't doing that for me.

Maybe add this:

        If ws.Name <> "Consolidated" And ws.Visible = True Then
            AcctCol = ws.Cells.Find(AcctColStr, After:=ws.Range("A" & ws.Rows.Count), _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, _
                SearchFormat:=False).Column
            ws.Columns(AcctCol).AutoFilter Field:=1, Criteria1:=AcctNum

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.

There's a scales icon in my posts you can use for a reputation feedback.

And you can visit my site for more code excerpts. This macro for you was based on code from there, the link is in my signature.

Can you post the full macro again so we can see it in it's current complexity?

Odd, that looks like the original macro. I don't see any changes, including the one you got from post #19.

The macro is collecting data going through the worksheets in the workbook one at a time. It's simply using the order of sheets that you have.

Try this:

Option Explicit

Sub ConsolidateInfoFromSheets()
'JBeaucaire (5/7/2010)
'Search all sheets in a workbook for one account
'and merge rows into one summary sheet (stacked)
Dim cs As Worksheet, ws As Worksheet, wbData As Workbook
Dim LR As Long, NR As Long, AcctCol As Long, ShtNum As Long
Dim sName As Boolean, fClose As Boolean
Dim fName As String, AcctColStr As String, AcctNum As Double
Application.ScreenUpdating = False

'String that will identify the account numbers in workbook
'sheets without this text string will be skipped
    AcctColStr = "Account Number"

'Prompt for an account number, activecell will be the default offered
    AcctNum = Application.InputBox("Enter the Account Number to consolidate", _
        "Account Number", IIf(IsNumeric(ActiveCell), ActiveCell, 0), Type:=1)
    If AcctNum = 0 Then Exit Sub

'Prompt for the workbook to open
    If MsgBox("Use the current activeworkbook?" & vbLf & vbLf & _
        "YES - current workbook will be consolidated" & vbLf & _
        "NO  - you will be allowed to select a workbook", vbYesNo) = vbNo Then
        
        fName = Application.GetOpenFilename("Microsoft Office Excel Files (.xls),.xls")
        If fName = "False" Then Exit Sub
        Set wbData = Workbooks.Open(fName)
        fClose = True
    End If

'Add consolidation sheet if needed
    If Not Evaluate("ISREF(Consolidated!A1)") Then _
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Consolidated"

'Option to add sheet names to consolidation report
    sName = MsgBox("Add sheet names to consolidation report?", vbYesNo + vbQuestion) = vbYes

'Setup
    Set cs = Sheets("Consolidated")
    cs.Cells.ClearContents
    NR = 1
    On Error GoTo Next1

'Process each data sheet in selected workbook
    For ShtNum = Sheets.Count To 1 Step -1
        Set ws = Sheets(ShtNum)
        If ws.Name <> "Consolidated" And ws.Visible = True Then
            AcctCol = ws.Cells.Find(AcctColStr, After:=ws.Range("A" & ws.Rows.Count), _
                LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, _
                SearchFormat:=False).Column
            ws.Columns(AcctCol).AutoFilter Field:=1, Criteria1:=AcctNum
            LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            If LR > 1 Then  'make sure there is at least one row to copy
                'find range to copy
                If NR = 1 Then      'copy with titles in row 1
                    ws.Range("A1:Z" & LR).Copy
                Else                'copy without titles
                    ws.Range("A2:Z" & LR).Copy
                End If
            
                If sName Then       'paste and add sheet names if required
                    cs.Range("B" & NR).PasteSpecial xlPasteValues
                    cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = ws.Name
                Else
                    cs.Range("A" & NR).PasteSpecial xlPasteValues
                End If
                
                NR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row + 1
            End If
            ws.AutoFilterMode = False
        End If
Next1:
    Next ShtNum
    
'Cleanup and save
    cs.Move
    If fClose Then wbData.Close False
    If sName Then [A1] = "Sheet"
    Rows(1).Font.Bold = True
    Cells.Columns.AutoFit
    ActiveWorkbook.SaveAs AcctNum & Format(Date, "  MM-DD-YY"), xlNormal
    Application.ScreenUpdating = True
End Sub

Account numbers cannot start with zero without first converting those cells to text....which goes against the idea of an account "number", eh?

Convert your account numbers to actual numbers, then use cell formatting to "display" leading zeros if you really feel you need to see them. Then the macro should work fine as designed.