CODEWITHSUNDEEP
vbaexcel
ClockworkNemo
ClockworkNemo

Reputation: 61

Excel VBA - Loop through workbook and label a cell with each sheet's name

I'm trying to write code where you click one cell on the active sheet and it loops through the rest of the sheets and labels that cell with each sheet's tab name.

The code below works fine if:

For Each Ws In Worksheets
        wb.Worksheets(1).Range("A1").FormulaR1C1 = ActiveSheet.Name
Next

but as soon as I call the input box variable, the code errors out. How should I correctly implement the input box into this code?

Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        .DisplayAlerts = Not opt
        .DisplayStatusBar = Not opt
        .EnableAnimations = Not opt
        .EnableEvents = Not opt
        .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub

Public Sub FastWS(Optional ByVal Ws As Worksheet = Nothing, _
                  Optional ByVal opt As Boolean = True)
    If Ws Is Nothing Then
        For Each Ws In Application.ActiveWorkbook.Sheets
            EnableWS Ws, opt
        Next
    Else
        EnableWS Ws, opt
    End If
End Sub

Private Sub EnableWS(ByVal Ws As Worksheet, ByVal opt As Boolean)
    With Ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub

Sub SheetLabel()

Dim Ws As Worksheet
Dim wb As Workbook
Dim t As Double
Dim cellVal As Range
Set wb = Application.ActiveWorkbook

'Optimize Macro Speed
FastWB True: t = Timer


Set cellVal = Application.InputBox("Click cell to add label to", Type:=8)


For Each Ws In Worksheets
        wb.Worksheets(1).Range("cellVal").FormulaR1C1 = ActiveSheet.Name
Next

FastWB False: MsgBox CStr(Round(Timer - t, 2)) & "s" 'Display duration of task

End Sub

Upvotes: 1

Views: 1107

Answers (2)

DisplayName
DisplayName

Reputation: 13386

Edit: after some downvotes, I realized what the OP wanted to do and edited answer accordingly...

Dim cellAddress As String
cellAddress = Application.InputBox("Click cell to add label to", Type:=8).Address

For Each Ws In Worksheets
    ws.Range(cellAddress).FormulaR1C1 = ws.Name
Next

or, if you want to check for any invalid user input range:

Dim cellVal As Range
Set cellVal = Application.InputBox("Click cell to add label to", Type:=8)

If Not cellVall Is Nothing Then
    Dim cellAddress As String
    cellAddress = cellVal.Address
    For Each Ws In Worksheets
        ws.Range(cellAddress).FormulaR1C1 = ws.Name
    Next
End If

Upvotes: 0

chris neilsen
chris neilsen

Reputation: 53126

Try this

Sub SheetLabel()
    Dim Ws As Worksheet
    Dim SelectedCell As Range

    Set SelectedCell = Application.InputBox("Click cell to add label to", Type:=8)
    For Each Ws In Worksheets
        Ws.Range(SelectedCell.Address).Value = Ws.Name
    Next
End Sub

Upvotes: 2

Related Questions