1

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
Scott Craner
  • 148,073
  • 10
  • 49
  • 81
aksnave
  • 13
  • 2
  • Result after 1 worksheet modified as expected: VBA Run-time error '1004': Select method of Range class failed – aksnave Jun 16 '17 at 17:00
  • You need to get rid of all the `.Select` and `Selection.` see here for information: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros . – Scott Craner Jun 16 '17 at 17:00
  • ^^^^ is the best method, baring that if you activate the sheet, which is terrible coding, it should work. `.Activate` right after the `With ws`. You cannot select a range on an inactive sheet. But seriously get rid of the activate and select. it will make the code quicker and more reliable. – Scott Craner Jun 16 '17 at 17:02
  • Thanks for the tip. Excel's Record macro put all the ActiveCell and Select in there. I will attempt to cut the excess and clean it up. Thanks! – aksnave Jun 16 '17 at 17:14

1 Answers1

1

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.

  • This is really clean...thanks for the help! I fixed up the row/column references and the misplaced Range. Very quick and efficient script now! – aksnave Jun 16 '17 at 18:58