Consulting

Results 1 to 3 of 3

Thread: Loop through all visible worksheets in excel

  1. #1

    Loop through all visible worksheets in excel

    hi
    I have a code which converts a single worksheet to xml. Now I want that all worksheets data of a workbook to get converted to xml at same time on a single click.
    I am pasting the code which I am using

    findusedrange subroutine which automatically selects the non empty continuous region of the current/active worksheet
    [vba]' To automatically select the "REAL"/non empty continuous regions (rows and columns)
    Sub FindUsedRange()
    Dim LastRow As Long
    Dim FirstRow As Long
    Dim LastCol As Integer
    Dim FirstCol As Integer
    ' Find the FIRST real row
    FirstRow = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByRows).Row
    ' Find the FIRST real column
    FirstCol = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByColumns).Column
    ' Find the LAST real row
    LastRow = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    ' Find the LAST real column
    LastCol = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    'Select the ACTUAL Used Range as identified by the variables identified above
    'MsgBox (FirstRow & "," & LastRow & "," & FirstCol & "," & LastCol)
    Dim topCel As Range
    Dim bottomCel As Range
    Set topCel = Cells(FirstRow, FirstCol)
    Set bottomCel = Cells(LastRow, LastCol)
    ActiveSheet.Range(topCel, bottomCel).Select
    End Sub[/vba]

    Subroutine for writing plain string out a file
    [vba]Sub sWriteFile(strXML As String, strFullFileName As String)
    Dim intFileNum As String
    intFileNum = FreeFile
    Open strFullFileName For Output As #intFileNum
    Print #intFileNum, strXML
    Close #intFileNum
    End Sub[/vba]

    These subroutines have been called on a button click
    [vba]Private Sub CmdProcessXML_Click()
    Dim strXML As String
    If Application.Count(Selection) = 0 Then
    FindUsedRange
    End If
    'fGenerateXML sub routine generates xml from an excel range strXML = fGenerateXML(Selection, "issue")
    ' sWriteFile strXML, ThisWorkbook.Path & filenameinput
    sWriteFile strXML, filenameinput
    MsgBox ("Completed. XML Written to " & filenameinput)
    Startform.Hide
    End Sub[/vba]

    providing a default name to exported xml file and saving in the same directory in which xls file resides

    [vba]Private Sub UserForm_Initialize()
    filenameinput.Text = ThisWorkbook.Path & "\default.xml"
    End Sub[/vba]



    Thanks in advance
    Last edited by Aussiebear; 07-25-2011 at 02:47 PM. Reason: Added VBA tags

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Just use a simple loop

    [vba]

    For Each sh in Activeworkbook.Worksheets
    ...
    Next sh[/vba]

    and replace all reference to Activesheet with sh
    ____________________________________________
    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 Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    As xld said, you should replace activesheet with sh. You can set an input parameter for your routines to use sh.

    Replace the MsgBox with your code to run on the visible worksheets.
    [VBA]Sub Test()
    Dim sh As Worksheet
    For Each sh In Worksheets
    If sh.Visible = xlSheetVisible Then
    MsgBox sh.Name, vbInformation, "Is Visible"
    End If
    Next sh
    End Sub[/VBA]

    Some of your code may need an sh prefix. If you are doing something with the activesheet, you may want to add code to skip it in your loop.
    e.g.
    [VBA]Sub FindUsedRange(sh As Worksheet)
    Dim LastRow As Long
    Dim FirstRow As Long
    Dim LastCol As Integer
    Dim FirstCol As Integer
    ' Find the FIRST real row
    FirstRow = st.Cells.Find(What:="*", _
    SearchDirection:=xlNext, _
    SearchOrder:=xlByRows).Row

    ' Find the FIRST real column
    FirstCol = st.Cells.Find(What:="*", _
    SearchDirection:=xlNext, _
    SearchOrder:=xlByColumns).Column

    ' Find the LAST real row
    LastRow = st.Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
    ' Find the LAST real column
    LastCol = st.Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByColumns).Column

    'Select the ACTUAL Used Range as identified by the
    'variables identified above
    'MsgBox (FirstRow & "," & LastRow & "," & FirstCol & "," & LastCol)
    Dim topCel As Range
    Dim bottomCel As Range

    Set topCel = Cells(FirstRow, FirstCol)
    Set bottomCel = Cells(LastRow, LastCol)

    st.Range(topCel, bottomCel).Select
    End Sub

    [/VBA]

Posting Permissions

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