excel - VBA Table Looping and Multiline If Statements - Stack Overflow

admin管理员组

文章数量:1122832

I have my code setup to loop through all the tables in the active worksheet and I want it to Place Enter Name in the top left cell, and if it says Enter Name the column to the right should be blank, and the cells below should also be blank.

But if there is a name in the Top left cell, I want it to copy the name to the cell directly below and the cell to the right of that cell should say Enter Name.

So far the code seems to only run all the If statement lines on the last table in worksheet, and for any other table it will only run the first line of both If statements.

Does anyone know what might be going on?

Public Variables:

Option Explicit

Public WS As WorkSheet

Public Table As ListObject

Public HeaderRange As Range

Public Const sheet = "Sheet1"

Public tAds As String
Public Rng As String
Public TopLeft As String

Public LastRow As Long
Public LastColumn As Long

Worksheet Code with Sub Call:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Set WS = ActiveWorkbook.Worksheets(sheet)

    For Each Table In WS.ListObjects

        Set HeaderRange = Table.HeaderRowRange

        TopLeft = HeaderRange.Cells(1,1).Address(0,0)
        Rng = Range(TopLeft).Offset(1,0).Address(0,0)

        If Not Intersect(Target, Range(Rng)) Is Nothing Then
            Call ToName(Target)
        End If
    Next Table
End Sub

Sub being Called:

Option Explicit

Sub ToName(ByVal Target As Range)

If Range(Rng).Value = "" Then Range(Rng).Value = "Enter Name"

    If Range(Rng).Value <> "Enter Name" Then
        Sheets(sheet).Range(Rng).Offset(1,1).Value = "Enter Name" 
        Sheets(sheet).Range(Rng).Offset(1,0).Value = Range(Rng).Value
    Else
        If Range(Rng) = "Enter Name" Then
            Sheets(sheet).Range(Rng).Offset(1,1).Value = "" 
            Sheets(sheet).Range(Rng).Offset(1,0).Value = ""
        End If
    End If
End Sub

I have my code setup to loop through all the tables in the active worksheet and I want it to Place Enter Name in the top left cell, and if it says Enter Name the column to the right should be blank, and the cells below should also be blank.

But if there is a name in the Top left cell, I want it to copy the name to the cell directly below and the cell to the right of that cell should say Enter Name.

So far the code seems to only run all the If statement lines on the last table in worksheet, and for any other table it will only run the first line of both If statements.

Does anyone know what might be going on?

Public Variables:

Option Explicit

Public WS As WorkSheet

Public Table As ListObject

Public HeaderRange As Range

Public Const sheet = "Sheet1"

Public tAds As String
Public Rng As String
Public TopLeft As String

Public LastRow As Long
Public LastColumn As Long

Worksheet Code with Sub Call:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Set WS = ActiveWorkbook.Worksheets(sheet)

    For Each Table In WS.ListObjects

        Set HeaderRange = Table.HeaderRowRange

        TopLeft = HeaderRange.Cells(1,1).Address(0,0)
        Rng = Range(TopLeft).Offset(1,0).Address(0,0)

        If Not Intersect(Target, Range(Rng)) Is Nothing Then
            Call ToName(Target)
        End If
    Next Table
End Sub

Sub being Called:

Option Explicit

Sub ToName(ByVal Target As Range)

If Range(Rng).Value = "" Then Range(Rng).Value = "Enter Name"

    If Range(Rng).Value <> "Enter Name" Then
        Sheets(sheet).Range(Rng).Offset(1,1).Value = "Enter Name" 
        Sheets(sheet).Range(Rng).Offset(1,0).Value = Range(Rng).Value
    Else
        If Range(Rng) = "Enter Name" Then
            Sheets(sheet).Range(Rng).Offset(1,1).Value = "" 
            Sheets(sheet).Range(Rng).Offset(1,0).Value = ""
        End If
    End If
End Sub

• excel
• vba
• for-loop
• listobject

Share Improve this question Follow asked Nov 22, 2024 at 20:55 SchuldaktSchuldakt 133 bronze badges 7

• Have you tried stepping through the code? – cybernetic.nomad Commented Nov 22, 2024 at 21:06
• @cybernetic.nomad I am attempting to step through it now, but the vba editor in excel keeps giving me an error sound when I hit F8. – Schuldakt Commented Nov 22, 2024 at 21:27
• If you're having trouble with stepping through, add debug.print header.name inside the loop to make sure you're picking that up and also print Range(Rng).Value & len(Range(Rng).Value). Could be a combo of data or that you're not actually having more than one header to act upon. – Cyril Commented Nov 22, 2024 at 21:40
• I would swap out Public Rng As String for Public Rng As Range and cut out the Address/Range(address) round-tripping. That only introduces potential bugs in your code if (eg) the worksheet with the change event is not active when the event fires. – Tim Williams Commented Nov 22, 2024 at 23:23
• I'm not quite following, so a screenshot would be useful here I think. – Tim Williams Commented Nov 22, 2024 at 23:41

 |  Show 2 more comments

1 Answer 1

Sorted by: Reset to default 0

Excel just loops through Worksheet_Change since you change the worksheet inside the subroutine at least at one assignment and possible in others. Use Application.EnableEvents = False: payload code: Application.EnableEvents = True

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Set WS = ActiveWorkbook.Worksheets(sheet)

    For Each Table In WS.ListObjects

        Set HeaderRange = Table.HeaderRowRange

        TopLeft = HeaderRange.Cells(1,1).Address(0,0)
        Rng = Range(TopLeft).Offset(1,0).Address(0,0)

        If Not Intersect(Target, Range(Rng)) Is Nothing Then
            Call ToName(Target)
        End If
    Next Table
    Application.EnableEvents = True
End Sub

Also, refactor the code.

本文标签： excelVBA Table Looping and Multiline If StatementsStack Overflow