VBA Loop not moving to next worksheet

[hellokitty]

Hi there,

I'm having troubles with some code and I'm hoping someone might be able to help. The file I'm working on needs to move selected worksheets (which have inconsistent format in terms of columns and rows) to a new worksheet, and then format them by deleting rows and columns that are not required.

The deleting rows/columns is achieved by calling two procedures in the main procedure. These rely on tags (values of 1) in column FF to identify which rows to delete, and row 2 (after the row procedure has been completed) to determine which columns to delete.

It works find in terms of moving the worksheets to a new book, and doing the formatting/deletions on the first worksheet, but not the remainder (no errors, etc).

I suspect its something to do with the delete row/column procedures I'm calling, but I can't seem to figure it out... any help greatly appreciated! Code reproduced below:

Sub MoveToNewFile()

'This procedure moves the Annexes to a new workbook and formats correctly for inclusion in the pdf version of _
the annexes

' Turn of screen updating; turn off calculation so worksheets in new workbook are not recalculated (resulting _
in errors due to links not working)

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Application.StatusBar = "Copying to new file"

ActiveWorkbook.Worksheets(Array("Annex 15", _
            "Annex 16 Page 1", _
            "Annex 16 Page 2", _
            "Annex 16 Page 3", _
            "Annex 16 Page 4", _
            "Annex 16 Page 5", _
            "Annex 16 Page 6", _
            "Annex 16 Page 7", _
            "11 MARKET 11", _
            "11 MARKET 31", _
            "11 MARKET 10", _
            "11 MARKET HighTISBO", _
            "11 MARKET V HighTISBO", _
            "11 MARKET 12", _
            "11 MARKET 29", _
            "11 MARKET 13", _
            "11 MARKET 14", _
            "11 MARKET 8", _
            "11 MARKET WBA 1", _
            "11 MARKET WBA 2", _
            "12 MARKET 27", _
            "12 MARKET 7", _
            "13 MARKET 4", _
            "13 MARKET 9", _
            "PY WBA")).Copy
            
' Paste values

Application.StatusBar = "Formatting worksheets"

For Each Worksheet In ActiveWorkbook.Worksheets
    
Application.StatusBar = "Hard Coding Values"

    Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Application.CutCopyMode = False
    
Application.StatusBar = "Deleting Rows and Columns not Required"

' Delete Rows not required
    
    Call DeleteRows
    
'Delete Columns not required

    Call DeleteColumns
    
Next
      
ActiveWorkbook.Worksheets("Annex 15").Select
                           
ThisWorkbook.Activate
ThisWorkbook.Worksheets("Print").Select

               
Application.StatusBar = False
Application.StatusBar = ""


Application.ScreenUpdating = True

End Sub

____________________________________________
Sub DeleteRows()

'Note: Column "FF" must contain "1" on rows that are required to be deleted.

Dim FirstRow As Long, LastRow As Long, Lrow As Long

'For Each Worksheet In ActiveWorkbook.Worksheets

With ActiveSheet

FirstRow = .UsedRange.Cells(1).Row
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

For Lrow = LastRow To FirstRow Step -1

With Cells(Lrow, "FF")

If .Value = 1 Then .EntireRow.Delete
    
End With

Next Lrow

End With

'Next

End Sub
_________________________________________________
Sub DeleteColumns()

'Note: Second Row following deletion of rows must contain "1" in columns that are required to be deleted

Dim FirstCol As Long, LastCol As Long, LCol As Long

'For Each Worksheet In ActiveWorkbook.Worksheets

With ActiveSheet

FirstCol = .UsedRange.Cells(1).Column
LastCol = .UsedRange.Columns(.UsedRange.Columns.Count).Column

For LCol = LastCol To FirstCol Step -1

With Cells(2, LCol)

If .Value = 1 Then .EntireColumn.Delete
    
End With

Next LCol

End With

'Next

End Sub

 

[ChrisOswald]

So, what's happening in your two subs is that you're only working on the active sheet. what you probably could do is something like this (code changes in red)

Option Explicit
Sub MoveToNewFile()
    [COLOR=red]Dim WS As Worksheet[/COLOR]
'This procedure moves the Annexes to a new workbook and formats correctly for inclusion in the pdf version of _
  the annexes
' Turn of screen updating; turn off calculation so worksheets in new workbook are not recalculated (resulting _
  in errors due to links not working)
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Copying to new file"
    ActiveWorkbook.Worksheets(Array("Annex 15", _
                                    "Annex 16 Page 1", _
                                    "Annex 16 Page 2", _
                                    "Annex 16 Page 3", _
                                    "Annex 16 Page 4", _
                                    "Annex 16 Page 5", _
                                    "Annex 16 Page 6", _
                                    "Annex 16 Page 7", _
                                    "11 MARKET 11", _
                                    "11 MARKET 31", _
                                    "11 MARKET 10", _
                                    "11 MARKET HighTISBO", _
                                    "11 MARKET V HighTISBO", _
                                    "11 MARKET 12", _
                                    "11 MARKET 29", _
                                    "11 MARKET 13", _
                                    "11 MARKET 14", _
                                    "11 MARKET 8", _
                                    "11 MARKET WBA 1", _
                                    "11 MARKET WBA 2", _
                                    "12 MARKET 27", _
                                    "12 MARKET 7", _
                                    "13 MARKET 4", _
                                    "13 MARKET 9", _
                                    "PY WBA")).Copy
    ' Paste values
    Application.StatusBar = "Formatting worksheets"
    [COLOR=red]For Each WS In ActiveWorkbook.Worksheets[/COLOR]
        Application.StatusBar = "Hard Coding Values"
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                        :=False, Transpose:=False
        Application.CutCopyMode = False
        Application.StatusBar = "Deleting Rows and Columns not Required"
        ' Delete Rows not required
        Call DeleteRows([COLOR=red]WS[/COLOR])
        'Delete Columns not required
        Call DeleteColumns([COLOR=red]WS[/COLOR])
    Next
    ActiveWorkbook.Worksheets("Annex 15").Select
    ThisWorkbook.Activate
    ThisWorkbook.Worksheets("Print").Select
 
    Application.StatusBar = False
    Application.StatusBar = ""
 
    Application.ScreenUpdating = True
End Sub
 
Sub DeleteRows([COLOR=red]WS As Worksheet[/COLOR])
'Note: Column "FF" must contain "1" on rows that are required to be deleted.
    Dim FirstRow As Long, LastRow As Long, Lrow As Long
    'For Each Worksheet In ActiveWorkbook.Worksheets
    With WS
        FirstRow = .UsedRange.Cells(1).Row
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        For Lrow = LastRow To FirstRow Step -1
                [COLOR=red]If .Cells(Lrow, "FF").Value = 1 Then Rows(Lrow).Delete[/COLOR]
        Next Lrow
    End With
    'Next
End Sub
 
Sub DeleteColumns([COLOR=red]WS As Worksheet[/COLOR])
'Note: Second Row following deletion of rows must contain "1" in columns that are required to be deleted
    Dim FirstCol As Long, LastCol As Long, LCol As Long
    'For Each Worksheet In ActiveWorkbook.Worksheets
    With WS
        FirstCol = .UsedRange.Cells(1).Column
        LastCol = .UsedRange.Columns(.UsedRange.Columns.Count).Column
        For LCol = LastCol To FirstCol Step -1
                [COLOR=red]If .Cells(2, LCol).Value = 1 Then .Columns(LCol).Delete[/COLOR]
        Next LCol
    End With
    'Next
End Sub

So what's happening now is you're passing a reference to the worksheet you're currently on in your loop in your MoveToNewFile sub, and then operating on that worksheet.

NOTE: I haven't really tested this out -- I didn't feel like creating a workbook with worksheets containing a ~150 columns. For that matter, I don't feel like looking at a workbook with worksheets containing ~150 columns

 

[hellokitty]

Thanks ChrisOswald - I'll give it a try and see if it works.

I agree with you on the 150 columns bit... I question my chosen career some days!

Thanks again,

HK