Excel Table Reference

[Thompyt]

I am trying to get how to reference a cell in an excel table from Columns(1) I see how Cells.offset(0,1) will do Columns(2) / or (0,2) Columns(3). That works, but I don't need it to go through all the workbook sheets then insert the last IPa into all the sheets. It takes a lot longer to run and not what I am looking for. Any pointer on what changes need to be done?

Option Explicit
Sub AddSheets()    
Dim IPA As String
Dim WkBk As Workbook, WkSht As Worksheet
Dim RCnt As Long, RwCnt As Long, IPCnt As Long, TblCnt As Long
Dim Cell As Range, Table1 As ListObject 


Set WkBk = Nothing
Set WkSht = Nothing
    
Set WkBk = ActiveWorkbook
Set WkSht = ActiveSheet
    ActiveWorkbook.Sheets("Baseline").Activate


    Call ClearTable


    Application.ScreenUpdating = False


Set Table1 = Worksheets("Baseline").ListObjects.Add(1, Range("A4:C100"), , xlYes)


TblCnt = Table1.ListRows.Count 'trying to use the row count to ensure we are looking at the right cell.  TblCnt shows the MAX number of rows.  ?? RwCnt = 1 to TblCnt next RwCnt ??? 


    For Each Cell In Table1.DataBodyRange.Columns(1).Cells
        If SheetExists(Cell.Value) = False And Cell.Value <> "" Then
            Set WkSht = Sheets.Add(before:=Sheets(Sheets.Count))
                WkSht.Name = Cell.Value
        End If
    For Each WkSht In Worksheets
            Select Case WkSht.Name
            Case "Baseline"
            Case "System Count"
            Case Else
                With WkSht
                    .Range("A1:A3").Font.Bold = True
                    .Range("A1:A3").Font.ColorIndex = 1
                    .Range("A1:A3").Font.Size = 11
                    .Range("A1:A3").Interior.ColorIndex = 15
                    .Cells(1, 1) = "Network IP"
                    .Cells(1, 2) = Cell.Offset(0, 1) & "0.0"
                    .Cells(2, 1) = "SubNet"
                    .Cells(3, 1) = "Broadcast IP"
                    ActiveSheet.Cells(1, 3).Select
                    .Cells(1, 3).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'System Count'!A1", TextToDisplay:="System Count"
                    ActiveSheet.Cells(5, 1).Select
                            .Range("A5:F5").Font.Bold = True
                            .Range("A5:F5").Font.ColorIndex = 1
                            .Range("A5:F5").Font.Size = 11
                            .Range("A5:F5").Interior.ColorIndex = 15
                            .Cells(5, 5) = "System Owner"
                            .Cells(5, 1) = "IP Address"
                            .Cells(5, 2) = "URN"
                            .Cells(5, 3) = "Role Name"
                            .Cells(5, 4) = "System Type"
                            .Cells(5, 6) = "Notes"
                        ActiveSheet.Range("A1:F1").Select
                        ActiveSheet.Range("A1:F1").EntireColumn.AutoFit
                If Cell.Offset(0, 1) = "" Then
                    IPA = "0.0.0.0"
                Else
                    For IPCnt = 1 To 10
                        IPA = Cell.Offset(0, 1) & Cell.Offset(0, 2) & "." & IPCnt
                        .Cells(IPCnt + 5, 1) = IPA
                    Next IPCnt
                End If
            End With
        End Select
    Next WkSht
 Next Cell
 
    Call ClearTable
    
Set WkSht = Nothing
Set WkBk = Nothing
    
       Application.ScreenUpdating = True
       
End Sub

[June7]

You say what you don't need to do but it is not clear to me what you do want.

[Thompyt]

Under the bold I am trying to put an IP address in Column A of each referenced worksheet in an Excel Table. The IP address should be: IPA = Cell.Offset(0, 1) & Pnt & Cell.Offset(0, 2) & Pnt & Cell.Offset(0, 3) & Pnt & IPCnt

where Table1 has
Column (1) System Owner
Column 2 Octet1
Column 3 Octet2
Column 4 Octet3

Octet4 we get from : For IPCnt = 1 To 255

I would like to have the code run through 1 time for each System Owner. I did a debug.print WkSht.Name & " " & IPA and I can see it run through all the rows in the table each time. So I see Octet3 1 through 30 (Number of rows in table with a name in column 1) and then run through IPCnt 254 times for each of Octet3. Then when the sheets open on the workbook I see the output for Row 29 octet1.octet2.(Last Table row octet3. no matter what sheet.

I am looking for how to have it run 1 row of the table at a time. The Octets reference the System owner in the row. Building out the sheet layout is done.

Thanks
T

[June7]

Perhaps you should attach workbook for analysis.

Sorry, having a hard time following your description of desired behavior.

[Thompyt]

Cutsheet .zip

Once open run Addsheet (ctrl h)

[Minty]

I would stick your feed values into an array, calculate the new values into another array, then dump the results array into the worksheet in one hit, rinse and repeat for each sheet.
It would work almost instantly by comparison, however it's not particularly slow on my machine using the existing method.

Updating individual cells is comparatively slow - I do a lot of string manipulation in a pricing sheet for a client, sometimes there are 20000 source rows.
Before I used the array method it was taking 4-5 minutes to loop through it all, now it takes about 10 seconds.

You Cell range variable is a bit strange. It seems to get stuck, and I have no Idea why.
I would have called it something else for clarity, it's too close to Cells to make for easy reading.

If you use the array method it will be easier to debug the values I suspect.

[Thompyt]

I think I have the first part of the array. The issue I have here is that the index does not follow the rows. Use ctrl+a as a shortcut to run or watch immediate window in the VBA editor.

Of note: You run the code once to get the odd sheets, then again to get the even sheets. This even makes the IP assignment worse as it is out of order.

Note: you need to copy this code onto the worksheet since it changes after I uploaded the zip file in this post.

Sub AddSht()

Set WkBk = ThisWorkbook
ActiveWorkbook.Sheets("Baseline").Activate


RwCnt = 0
ArrV = Empty

RwCnt = ActiveSheet.UsedRange.Rows.Count
Set Rng = WkBk.Worksheets("Baseline").Range("A2:D" & RwCnt)
ArrV = Rng.Value


For Each Cezz In Worksheets("Baseline").Range("A2:A" & RwCnt)
If SheetExists(Cezz.Value) = False And Cezz.Value <> "" Then
Set WkSht = Sheets.Add(Before:=Sheets(Sheets.Count))
WkSht.Name = Cezz.Value
With WkSht
Select Case WkSht.Name


Case "Baseline"
Case "System Count"
Case ""
Case Else


TblCnt1 = Sheets(.Name).Index
Debug.Print "Sheet Tab Number: " & Sheets(.Name).Index & " for " & WkSht.Name & " " & RwCnt, IPA 'Use index to force tblecnt to stay that number?
For IPCnt = 1 To 5
IPA = ArrV(TblCnt1, 2) & "." & ArrV(TblCnt1, 3) & "." & ArrV(TblCnt1, 4) & "." & IPCnt
.Cells(IPCnt, 1) = IPA
Next IPCnt
End Select
End With
End If
Next Cezz


Set WkSht = Nothing
Set WkBk = Nothing

RwCnt = 0
Erase ArrV

End Sub

Cutsheet_16NOV22.zip

[Minty]

Take out the check for the sheet existing - it fails.
Without that the following works

Sub AddSht()
    
    
    Dim sSheet As String
    Dim iRow As Integer
    
    Set WkBk = ThisWorkbook
    ActiveWorkbook.Sheets("Baseline").Activate




    RwCnt = 0
    'Erase ArrV


    RwCnt = ActiveSheet.UsedRange.Rows.Count
    Debug.Print RwCnt
    ReDim ArrV(RwCnt * 2, 5)
    Set Rng = WkBk.Worksheets("Baseline").Range("A2:D" & RwCnt)
    
    ArrV() = WkBk.Worksheets("Baseline").Range("A2:D" & RwCnt).Value
    
    Debug.Print ArrV(1, 1), RwCnt
    iRow = 1
    While iRow < RwCnt
    
        sSheet = ArrV(iRow, 1)
        'If Not SheetExists(sSheet) Then
        Debug.Print ArrV(iRow, 1)
        Set WkSht = Sheets.Add()
        WkSht.Name = sSheet
        With WkSht
            Select Case WkSht.Name
                Case "Baseline", "System Count", ""
                Case Else
                    TblCnt1 = iRow
                    Debug.Print "Sheet Tab Number: " & Sheets(.Name).Index & " for " & WkSht.Name & " " & TblCnt1, IPA 'Use index to force tblecnt to stay that number?
                    For IPCnt = 1 To 5
                        IPA = ArrV(TblCnt1, 2) & "." & ArrV(TblCnt1, 3) & "." & ArrV(TblCnt1, 4) & "." & IPCnt
                        .Cells(IPCnt, 1) = IPA
                    Next IPCnt
            End Select
        End With
        'End If
        'WkBk.Save
        Debug.Print iRow
        iRow = iRow + 1
    Wend
    
End Sub

[Thompyt]

Thank you Minty, I was looking at ReDim and Find later. i did not consider Wend. I did have to change ArrV() to ArrV as it was giving me an Out of Range error. Thank you very much. Next to figure out, incorporate a check for existing sheet and reverse the sheet sequence.