Consulting

View Poll Results: Did I do ok for my first timesaver?

Voters
0. You may not vote on this poll
  • To long, break it down into smaller sections

    0 0%
  • Reapeating the same operation to much

    0 0%
  • can do more with it, send me ideas.

    0 0%
  • scrap it and start over

    0 0%
Multiple Choice Poll.
Results 1 to 6 of 6

Thread: Solved: need to select and run macro on all worksheets in workbook consecutively

  1. #1
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location

    Solved: need to select and run macro on all worksheets in workbook consecutively

    OK, here is it, I'm cleaning a series of data from a enterprise database. It spits out a report that is printable but contains footers and excess data that I don't need, I recorded a basic Macro and set some fields for deletion. I’m new to this and have not had any one look at this. It runs in a decent amount of time and is long. The problem is that the server that this report comes from is over loaded and I’m limited and have had to take the report in chunks and not a single report. Now I get it in 1 to 20 seperate worksheets and would liek to run this macro on all sheets with out having to restart it for each. I know it can be doen I just can't find it and I know it is very basic. I could not even record close to what I need.

    How do I select all worksheets

    For each ws in activeworkbook.worksheets
    ws.activate

    a friend gave me that but it gives errors.


    PS I do not have my basics book with me it is in a different country now.

    How do I get it to select each active worksheet in a workbook, I’m sure this can be done with out a loop.

    Coserria

    OK, here is it, I'm cleaning a series of data from a enterprise database. It spits out a report that is printable but contains footers and excess data that I don't need, I recorded a basic Macro and set some fields for deletion. I’m new to this and have not had any one look at this. It runs in a decent amount of time and is long. The problem is that the server that this report comes from is over loaded and I’m limited and have had to take the report in chunks and not a single report.

    PS I do not have my basics book with me it is in a different country now.

    How do I get it to select each active worksheet in a workbook, I’m sure this can be done with out a loop.

    Coserria



    Application.ScreenUpdating = False

    Cells.MergeCells = False
    Cells.WrapText = False

    Range("A:B,D:E,S:S").Delete Shift:=xlToLeft





    Cells.Replace What:="Unit Cost", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="Line Cost", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="Date", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Cells.Replace What:="Item:", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="Location:", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="Description:", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="Item #:", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-A*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-B*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-C*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-D*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-F*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-G*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-H*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-T*", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="ME-IRQ-USMI", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Cells.Replace What:="Site: LOGCAP3", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Application.ScreenUpdating = True

    'rows and colums here down


    Dim Rw As Long, RwCnt As Long, rng As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    On Error GoTo Exits:


    If Selection.Columns.Count > 1 Then
    Set rng = Selection
    Else
    Set rng = Range(Columns(1), Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))
    End If
    ColCnt = 0
    For col = rng.Columns.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(rng.Columns(col).EntireColumn) = 0 Then
    rng.Columns(col).EntireColumn.Delete
    ColCnt = ColCnt + 1
    End If
    Next col

    'Range("B:B").Delete Shift:=xlToLeft

    If Selection.Rows.Count > 1 Then
    Set rng = Selection
    Else
    Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
    End If
    RwCnt = 0
    For Rw = rng.Rows.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
    rng.Rows(Rw).EntireRow.Delete
    RwCnt = RwCnt + 1
    End If
    Next Rw

    'insert cell for alignment

    Range("B1,D1").Insert Shift:=xlDown

    If Selection.Rows.Count > 1 Then
    Set rng = Selection
    Else
    Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
    End If
    RwCnt = 0
    For Rw = rng.Rows.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
    rng.Rows(Rw).EntireRow.Delete
    RwCnt = RwCnt + 1
    End If
    Next Rw

    Exits:

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Cells.Interior.ColorIndex = xlNone
    Cells.EntireColumn.AutoFit

    End Sub

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,145
    Location
    That code looks correct.What do you get?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location

    I think it is simple error.

    it comes back as a compile error: for without next


    this is taking place at END SUB

    i also had an error and had to chage the code below

    For each ws in activeworkbook.worksheets
    ws.activate

    TO:

    'For each ws in

    activeworkbook.worksheets
    ws.activate

    The basic code works great I spent a bit of time running though it a few months back. I just got back from vacation and the database people screwed me. Oh well I can adjust. just cant see the forest in the trees.

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,145
    Location
    You need a

    [vba]

    Next ws
    [/vba]

    at the end of the loop, after you have procesed the worksheet
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Try the following
    [vba]
    Option Explicit
    Sub Test()
    Dim ws As Worksheet
    Dim arr, a
    Dim Rw As Long, Col As Long, rng As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    arr = Array("Unit Cost", "Line Cost", "Date") 'add other terms to be deleted

    On Error GoTo Exits:
    For Each ws In Worksheets
    With ws
    .Activate
    .Cells.MergeCells = False
    .Cells.WrapText = False
    .Range("A:B,D:E,S:S").Delete Shift:=xlToLeft
    'Find and delete terms
    For Each a In arr
    .Cells.Replace What:=a, Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Next a
    'rows and colums here down
    Set rng = Range(ws.Columns(1), Columns(ws.Cells.SpecialCells(xlCellTypeLastCell).Column()))
    For Col = rng.Columns.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(rng.Columns(Col).EntireColumn) = 0 Then
    rng.Columns(Col).EntireColumn.Delete
    End If
    Next Col
    Set rng = Range(ws.Rows(1), Rows(ws.Cells.SpecialCells(xlCellTypeLastCell).Row()))
    For Rw = rng.Rows.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
    rng.Rows(Rw).EntireRow.Delete
    End If
    Next Rw
    'insert cell for alignment
    .Range("B1,D1").Insert Shift:=xlDown
    Set rng = Range(ws.Rows(1), Rows(ws.Cells.SpecialCells(xlCellTypeLastCell).Row()))
    For Rw = rng.Rows.Count To 1 Step -1
    If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
    rng.Rows(Rw).EntireRow.Delete
    End If
    Next Rw
    .Cells.Interior.ColorIndex = xlNone
    .Cells.EntireColumn.AutoFit
    End With
    Next ws
    Exits:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    End Sub
    [/vba]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  6. #6
    VBAX Regular
    Joined
    Nov 2007
    Posts
    24
    Location

    running correctly just resetting absolute settings

    Thanks for the help,

    I leaned a bit form that.

    For the ones that are intersted in before it is cleaned report that is received is variable from 200 rows to well over a 1000.

    the received code deffinatly helps I jsut have to go and reset the non variables.

    Cheers thank for the assistance.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •