Vba loop through cells

mdo8105

Board Regular
Joined
Nov 13, 2015
Messages
83
I have a code that grabs all the sheet names in the workbook and creates a sheet with the names on it. I am essentially trying to have it loop through the cells until it hits a blank cell, but for the life of me I cannot figure it out. Each cell on Sheet("Test") is a name of a Worksheet. Here is my code.

Code:
Sub ListWorkSheet()



Dim xWs As Worksheet
Dim strName As String
Dim MyCell, Rng As Range
Const WHAT_FIND1 As String = "Tracker"
Dim FindCellT As Excel.Range




On Error Resume Next
Application.DisplayAlerts = False
xTitleId = "Test"
Application.Sheets(xTitleId).Delete
Application.Sheets.Add Application.Sheets(1)
Set xWs = Application.ActiveSheet
xWs.Name = xTitleId
For i = 2 To Application.Sheets.Count
    xWs.Range("A" & (i - 1)) = Application.Sheets(i).Name
Next
Application.DisplayAlerts = True




    Set FindCellT = Sheets("Test").Range("A:A").Find(What:=WHAT_FIND1, LookAt:=xlWhole)


    T1 = FindCellT.Offset(1, 0).Row
    T2 = FindCellT.End(xlDown).Row
    Set Rng = Sheets("Test").Range("A" & T1, "A" & T2)
For Each MyCell In Rng
    If MyCell <> "" Then
    strName = MyCell
Sheets(strName).Range("P1").Value = "Test"
    Else
        Exit Sub
    End If


Next


End Sub

Would love someone's wisdom on how to get it to work.
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Not sure what you are doing with "Tracker", but this will loop through the sheet names.

Code:
Sub ListWorkSheet()


    Const WHAT_FIND1 = "Tracker"


    Dim xWs As Worksheet, yWs As Worksheet
    Dim strName As String
    Dim MyCell, Rng As Range
    Dim FindCellT As Excel.Range
    Dim xTitleId As String
    Dim i As Long, T1, T2
    
    xTitleId = "Test"


    For Each xWs In ThisWorkbook.Worksheets
        If xWs.Name = xTitleId Then
            Application.DisplayAlerts = False
            xWs.Delete
            Application.DisplayAlerts = True
        End If
    Next xWs


    ThisWorkbook.Worksheets.Add
    Set xWs = ActiveSheet
    xWs.Name = xTitleId


    i = 0
    For Each yWs In ThisWorkbook.Worksheets
        If yWs.Name <> xWs.Name Then
            xWs.Range("A1").Offset(i) = yWs.Name
            i = i + 1
        End If
    Next yWs


    Set Rng = xWs.UsedRange
    Set MyCell = Rng.Range("A1").Offset(Rng.Rows.Count, 0).Resize(1, 1)
    MyCell.Select
    MsgBox "First blank cell: " & MyCell.Address


    'If you just want to loop through the sheet names then
    For Each MyCell In Rng
        strName = MyCell.Value
        Sheets(strName).Range("P1").Value = "Test"
    Next MyCell
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top