[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Extend Excel macro across multiple worksheets

Posted on 2013-01-14
4
Medium Priority
?
468 Views
Last Modified: 2013-01-15
The macro retrieves specific rows from a single worksheet. The objective is to have the macro work across all worksheets within the file. See attached file with macro attached to sheet 1.
2011-Australia-ailments-macro.xlsm
0
Comment
Question by:gregfthompson
[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
4 Comments
 
LVL 13

Expert Comment

by:Shanan212
ID: 38776282
Sub sample()

Dim wscounter As Long, rrow As Long, i As Long
Dim curWs As String, Main As Worksheet, irow As Long

Set Main = Sheets("Main")

wscounter = ActiveWorkbook.Worksheets.Count

    For i = 1 To wscounter
        ActiveWorkbook.Worksheets(i).Select
        curWs = ActiveWorkbook.Worksheets(i).Name
        
        If (curWs <> "Main") Then
            irow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
            Range("A4:N" & irow).Copy
            
            rrow = Main.Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
            
            Main.Range("A" & rrow + 1).PasteSpecial xlPasteValuesAndNumberFormats

            ActiveSheet.CutCopyMode = False
        End If
    Next i

End Sub

Open in new window


Should paste on sheet called 'Main'

So make a sheet called main and call the sub from there.
0
 
LVL 7

Accepted Solution

by:
Jignesh Thar earned 2000 total points
ID: 38776310
gregfthompson - you have kTest function (below code) in "1 Arthritis' sheet. It is written to action on each sheet.

The macro searches for specific condition and deletes rows.

Can you elaborate on what you are trying to achieve so that code can be changed?

Sub kTest()
    
    Dim i As Long, j As Long, r As Range, MyCodes
    Dim c As Long, Fmla  As String, p   As Long
    
    MyCodes = Array(2621)   '<<< put the required codes here
    
    Const HeaderRow As Long = 3
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    For i = 1 To Worksheets.Count
        With Worksheets(i)
            If .AutoFilterMode Then .AutoFilterMode = False
            p = .Range("a" & .Rows.Count).End(3).Row
            c = .Cells(HeaderRow, .Columns.Count).End(-4159).Column + 2
            With .Range("a" & HeaderRow & ":a" & p)
                Fmla = "=AND(A" & HeaderRow + 1 & "<>{"
                For j = LBound(MyCodes) To UBound(MyCodes)
                    Fmla = Fmla & MyCodes(j) & ","
                Next
                Fmla = Left(Fmla, Len(Fmla) - 1) & "})"
                .Cells(2, c).Formula = Fmla
                .AdvancedFilter 1, .Cells(1, c).Resize(2)
                Set r = .Cells(1).Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)
                If Not r Is Nothing Then r.EntireRow.Delete
                Set r = Nothing
                .Cells(2, c).ClearContents
            End With
            .ShowAllData
        End With
    Next
    
End Sub

Open in new window

0
 

Author Comment

by:gregfthompson
ID: 38781090
jigneshthar,

Thanks for your question.

I want to be able to amend "MyCodes = Array(2621)" to a specific postcode and then have each worksheet show only the rows that contain that postcode.

Does this make sense?

Thanks,

Greg
0
 

Author Comment

by:gregfthompson
ID: 38781097
Oops. My error.  It already works as required.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
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…

650 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