Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

code to loop through spreadsheets

Status
Not open for further replies.

breilly192

Technical User
Nov 19, 2002
16
US
I need to create some code to loop through multiple sheets of an Excel workbook, same format for each sheet, and extract the relevent data - acct nbr, amount, etc - where the amounts are <> 0 and either dump into a table or another sheet. From there, will dump into flat file.

Any tips on pulling the selected columns - ex. col B, col. C, col. D, col F - without pulling all rows and columns? The sheets are set up in report format with summaries, etc, which I will ignore to pull only rows that have acct nbs and where amount <> 0.

Would it work cleaner to write into an Accesss table and create the flat file from there?
 
I would suggest you record a macro to do the following steps for one sheet:

1. Select a sheet
2. Set up auto-filter
3. Set the filter for rows that have acct nbs and amount <> 0
4. Copy the data to the consolidation sheet
5. Clear the auto-filter

Then modify the macro to wrap it with a control structure like this:
Code:
Dim wks as worksheet
For each wks in Worksheets
  wks.Activate
  (your code goes here)
Next wks
(Remove the hard-coded line from the recorded steps where you selected one specific worksheet.)
You would also need to add code to select the correct cell to copy into on the consolidation sheet. (Something like Cells(65536,1).End(xlUp).Offset(1,0).Select is one way to do it.)

Finally, remove any unwanted columns from the consolidation.
 
Thanks Zathras!
a working model except for two things: 1) using the macro to do a copy paste, the code set a specific range that might not be the appropriate rows for following sheets, based on the filter criteria - <>0 for example. How do you make it general enough to be applied to all sheets dependent on the filter criteria as applied to each one?
2) how do you mark the paste area in the code so that each consecutive sheet copied to it does not overlap in the consolidation sheet?

Bill

 
Here is one way to do it:
[blue]
Code:
Option Explicit

Sub Consolidate()
Dim wks As Worksheet
Dim bIncludeHeadings As Boolean
[green]
Code:
  ' Clear summary sheet
[/color]
Code:
  Worksheets(&quot;Summary&quot;).UsedRange.Clear
[green]
Code:
  ' Copy data from detail sheets to summary
[/color]
Code:
  bIncludeHeadings = True
  For Each wks In Worksheets
    If wks.Name <> &quot;Summary&quot; Then
      CopyDataFrom wks, bIncludeHeadings
      PasteDataTo Worksheets(&quot;Summary&quot;)
      bIncludeHeadings = False
    End If
  Next wks
[green]
Code:
  ' Remove unwanted columns and auto-fit (Note: delete from right to left)
[/color]
Code:
  With Worksheets(&quot;Summary&quot;)
    .Columns(&quot;G&quot;).Delete
    .Columns(&quot;F&quot;).Delete
    .Columns(&quot;D&quot;).Delete
    .Cells.Select
    .Cells.EntireColumn.AutoFit
    .Range(&quot;A1&quot;).Select
  End With
End Sub

Sub CopyDataFrom(AWorksheet As Worksheet, IncludeHeadings As Boolean)
Dim rngCopy As Range

  With AWorksheet
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range(&quot;B1&quot;).AutoFilter Field:=2, Criteria1:=&quot;<>0&quot;, Operator:=xlAnd
    Set rngCopy = .UsedRange.SpecialCells(xlCellTypeVisible)
    If IncludeHeadings Then
      rngCopy.Copy
    Else
      Intersect(rngCopy, .Range(&quot;2:65536&quot;)).Copy
    End If
    .AutoFilterMode = False
  End With
  Set rngCopy = Nothing

End Sub

Sub PasteDataTo(AWorksheet As Worksheet)
Dim rngPasteHere As Range
  With AWorksheet
    Set rngPasteHere = .Cells(65536, 1).End(xlUp)
    If rngPasteHere.Row > 1 Then
      Set rngPasteHere = rngPasteHere.Offset(1, 0)
    End If
    rngPasteHere.PasteSpecial (xlPasteValues)
  End With
End Sub
[/color]

 
Zathras,

Although this looping code works, for some reason (is it an Excel issue or the code?) the range criteria works on the first sheet, but not on subsequent sheets.
 
Not sure what you mean by &quot;range criteria&quot; -- do you mean the filter criteria [blue] &quot;<>0&quot; [/color] ?

Not sure what you mean by &quot;works...but not on subsequent sheets&quot; -- does the auto-filter not auto-filter? does the copy not copy? does the paste not paste? There are dozens of ways for it to &quot;not work&quot; You aren't giving me much to go on here.

Are all of the sheets really set up the same way? (column by column) or do some have an extra column somwhere?

Try to set the auto-filter manually.

Are the zero values you are testing for really numbers or are they strings (as may happen if the data are pasted in and not keyed in)?

You never actually gave details as to what data were in what columns, so you may have to adjust the code to fit your precise setup. All I could do is guess and provide pro-forma code to give you an idea of how to proceed. Perhaps the field number is what is wrong. Did you ever actually record a macro as I suggested? If you do you can then see what to use for column numbers, criteria, etc.
 
Here's the code, based around what you gave me. The copy & paste works fine, however, for some reason, the filter criteria do as required on first sheet, but next sheet it sets the range and copies and pastes, but the filter criteria aren't being applied.

I'm just testing it against a model now and the second sheet is a clone of the first, with the acct# and co, etc different.

Sub CopyDataFrom(AWorksheet As Worksheet)
Dim rngCopy As Range

With AWorksheet
If .AutoFilterMode Then .AutoFilterMode = False
Range(&quot;A:N&quot;).Select
Range(&quot;A8&quot;).AutoFilter Field:=9, Criteria1:=&quot;>=1&quot;, Operator:=xlOr, _
Criteria2:=&quot;<=99&quot;
Range(&quot;N8&quot;).AutoFilter Field:=14, Criteria1:=&quot;>0&quot;, Operator:=xlOr, _
Criteria2:=&quot;<0&quot;
Set rngCopy = .UsedRange.SpecialCells(xlCellTypeVisible)
'rngCopy.Copy
Intersect(rngCopy, .Range(&quot;A8:N650&quot;)).Copy
.AutoFilterMode = False
End With
Set rngCopy = Nothing
 
The problem would seem to be in the data, not the code. But looking at the code, I don't understand the logic of Column I >= 1 or Column I <= 99. Any number you can name will meet those criteria. (If it is less than 1 it is still less than 99 and therefore will be selected. Conversly if it is greater than 99 it is still greater than 1 and therefore will be selected.)

Please look carefully at the data to see whether they are numbers or text. You might try using a formula like
[blue]
Code:
   =CELL(&quot;type&quot;,E16)
[/color]

it will show v, l or b as follows:
Code:
   v = &quot;value&quot; i.e., an actual number
   l = &quot;label&quot; i.e., text (not a number)
   b = &quot;blank&quot; i.e., an empty cell
The other clue is that unless you specify left- or right- justify for the cell, numbers will appear right-justified and text will appear left-justified.

 
yeah, the filter should have been >= 1 AND <= 99. Thanks.

When I filter on the second sheet only, manually, the filter works properly. Conversely, if the second sheet happens to be the active sheet, instead of the first, the filter works against the second sheet and then not on the first, pointing me back to an activesheet coding issue.
 
never mind. I found the problem.

I left a Selection.AutoFilter after the loop that was getting applied on the summary page and taking the filter off.

Thanks for your help!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top