CODEWITHSUNDEEP
excelvbaloopsxlsxxls
aksnave
aksnave

Reputation: 13

Trying to get this vba to loop through all worksheets in the current workbook. It runs through the first

This looping VBA script stops after completing the first worksheet in the active workbook, but need it to loop through all of the worksheets. Can someone help me understand what I'm missing to get the loop to move successively through all of the worksheets?

Sub forEachws()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
  Call Music_Connect_Albums(ws)
  Next
End Sub

Sub Music_Connect_Albums(ws As Worksheet)
    With ws
    .Columns("B:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("A13").Select
    ActiveCell.FormulaR1C1 = "Artist"
    .Range("B13").Select
    ActiveCell.FormulaR1C1 = "Title"
    .Range("C13").Select
    ActiveCell.FormulaR1C1 = "Release"
    .Range("D13").Select
    ActiveCell.FormulaR1C1 = "Label"
    .Range("E13").Select
    ActiveCell.FormulaR1C1 = "Age"
    .Range("F13").Select
    ActiveCell.FormulaR1C1 = "Yr"
    .Range("G13").Select
    ActiveCell.FormulaR1C1 = "Wk"
    .Range("H13").Select
    ActiveCell.FormulaR1C1 = "Wk-End"
    .Range("A14").Select
    ActiveCell.FormulaR1C1 = "=R2C10"
    .Range("B14").Select
    ActiveCell.FormulaR1C1 = "=R3C10"
    .Range("C14").Select
    ActiveCell.FormulaR1C1 = "=R4C10"
    .Range("D14").Select
    ActiveCell.FormulaR1C1 = "=R5C10"
    .Range("E14").Select
    ActiveCell.FormulaR1C1 = "=R9C10"
    .Range("F14").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(R8C10,4)"
    .Range("G14").Select
    ActiveCell.FormulaR1C1 = "=MID(R13C10,6,2)"
    .Range("G14").Select
    ActiveCell.FormulaR1C1 = "=MID(R13C13,6,2)"
    .Range("H14").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(R8C10,10)"
    .Range("A14:H14").Select
    Selection.AutoFill Destination:=Range("A14:H35")
    .Range("A14:H35").Select
    .Columns("A:H").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Rows("1:13").Select
    .Range("A12").Activate
    .Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    .Columns("I").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End Sub

Upvotes: 1

Views: 156

Answers (1)

user4039065
user4039065

Reputation:

Here is a quick rewrite of your code without .Select or .Activate.

Option Explicit

Sub forEachws()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        Call Music_Connect_Albums(ws)
    Next
End Sub

Sub Music_Connect_Albums(ws As Worksheet)
    With ws
        .Columns("B:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("A13:H13").Value = Array("Artist", "Title", "Release", "Label", _
                                        "Age", "Yr", "Wk", "Wk-End")
        .Range("A14:H14").FormulaR1C1 = Array("=R2C10", "=R3C10", "=R4C10", "=R5C10", "=R9C10", _
                                               "=RIGHT(R8C10,4)", "=MID(R13C10,6,2)", "=MID(R13C13,6,2)", _
                                               "=RIGHT(R8C10,10)")
        With .Range("A14:H35")
            .FillDown
            'uncomment the next line after you have examined the formulas
            '.Value = .Value
        End With
        .Range("A12").Delete Shift:=xlUp
        On Error Resume Next
        .Columns("I").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
    End With
End Sub

Two areas of concern. First, I believe you designed your formulas with absolute row and column references that are not changing properly when filled down. You should look at the formulas before reverting to their calculated values. Second, the .Range("A12").Delete Shift:=xlUp seems out of place and the action does not seem to do something that improves the worksheet; you should look into that.

Upvotes: 1

Related Questions