for each currentregion is possible?

Question

Hi all,

in VBA excel is it possible to define a currentregion as an objet or a table and do a loop in teh differents currentregion?

Usaullay i have a list of tables in an excel sheet. When i have to work in these tables and i use offset tpo move from a table to another. I would like to do something like:

set rn=table (:-) yes, i know...)

for each table in activeworksheet

....

next

is there any way to do it?

a challenge :-)?

Regards

---

The most important in the answer is the question

Answer 1

Hello:

Here's a sample of code that will first create a worksheet (for the results of the code), then loop through all the worksheets in your workbook to search for tables.  When they are found, they are listed, along with the header information.

The key to this code is the ListObjects property.

Option Explicit

Sub ListTablesAndHeaders()
Dim tbl As ListObject
Dim WS As Worksheet
Dim i, j As Single
Set WS = Sheets.Add
i = 1
For Each WS In Worksheets
    For Each tbl In WS.ListObjects
        Range("A1").Cells(i, 1).Value = tbl.Name
        For j = 1 To tbl.Range.Columns.Count
            Range("A1").Cells(i, j + 1).Value = tbl.Range.Cells(1, j)
        Next j
        i = i + 1
    Next tbl
Next WS
End Sub

Regards,

---

Rich Locus, Logicwurks, LLC

http://www.logicwurks.com

Answer 2

Hi RichLocus,

thank you for your reply. It is a good idea to use ListObjects but there are several issues with your code:

1- when you add a table by default the table has not a name and it is not in the listobjects. So, the code works if you define a name to the table. Am i right?

2- In my case, i import a file. In these file there is severall tables not named. For example one hundred, so i can't rename each table manually. DO you think there is a way to do a loop into all the table not named?

:-)

Thank you for your help

regards

---

The most important in the answer is the question

Answer 3

Hi I wrote this code and it seems done what i want.

I have only one issue. i would like, before afffecting a new name to the range, check if the name exist. I used:

if rn3.name<>"" then...

But i have an error. Has someone any idea?

Thank you fro any help,

:-) thanks for your help. If you have a better idea that this code, pease let me know. I try to use Listobject but when the range has only 1 cells there are some issue.

regards

Sub activest()
Dim rn As Range
Set rn = ActiveSheet.UsedRange
Dim cellule As Range
Dim rn2 As Range, rn3 As Range
Dim b As Byte, bo As Boolean
Dim wok As Workbook
Dim str As String
Set wok = ActiveWorkbook

b = wok.Names.Count
Dim tbname As Name


Dim tbl As ListObject
Dim Ws As Worksheet
Set Ws = ActiveSheet



Set rn = ActiveSheet.UsedRange

For Each cellule In rn
bo = False
    If Not IsEmpty(cellule) Then

    Set rn3 = cellule.CurrentRegion
    
            If rn2 Is Nothing Then
            Set rn2 = rn3
            bo = 1
            Else
                If Application.Intersect(rn2, rn3) Is Nothing Then
                Set rn = Application.Union(rn2, rn3)
                bo = True
                End If
            End If
        End If
    
    If bo = True Then
        rn3.Name = "Tableau" & b

        
        b = b + 1
    End If

Next



'check
For Each tbname In wok.Names

'looop in the activeworksheet
str = Ws.Name
If InStr(1, tbname.RefersTo, str & "!") > 0 Then
    MsgBox tbname.RefersTo
End If

Next



End Sub

---

The most important in the answer is the question

Answer 4

Hi All,

at th end i used this macro. I delete all teh tablename of a specific file.

Sub activest()
Dim rn As Range
Set rn = ActiveSheet.UsedRange
Dim cellule As Range
Dim rn2 As Range, rn3 As Range
Dim b As Byte, bo As Boolean
Dim wok As Workbook
Dim str As String
Set wok = ActiveWorkbook

b = 1
Dim tbname As Name


Dim tbl As ListObject
Dim Ws As Worksheet
Set Ws = ActiveSheet


'Delete all name of the activasheet
For Each tbname In wok.Names

'looop in the activeworksheet
str = Ws.Name
If (InStr(1, tbname.RefersTo, str & "!") > 0 Or InStr(1, tbname.RefersTo, "#REF!") > 0) Then
    tbname.Delete
End If

Next


Set rn = ActiveSheet.UsedRange

For Each cellule In rn
bo = False
    If Not IsEmpty(cellule) Then

    Set rn3 = cellule.CurrentRegion

            If rn2 Is Nothing Then
            Set rn2 = rn3
            bo = 1
            Else
                If Application.Intersect(rn2, rn3) Is Nothing Then
                Set rn2 = Application.Union(rn2, rn3)
                bo = True
                End If
            End If
        End If

    If bo = True Then
        rn3.Name = "Tableau" & str & b


        b = b + 1
    End If

Next

 

'check
For Each tbname In wok.Names

'looop in the activeworksheet
str = Ws.Name
If InStr(1, tbname.RefersTo, str & "!") > 0 Then
    'MsgBox tbname.RefersTo
End If

Next

 

End Sub

If someone has a best idea it will be apprciated :-).

regards

---

The most important in the answer is the question

Answer 5

There is no need to loop through all the cells:

Sub Activest2()
    Dim b As Integer
    Dim str As String
    Dim wok As Workbook
    Dim tbname As Name
    Dim tbl As ListObject
    Dim Ws As Worksheet

    Set wok = ActiveWorkbook
    Set Ws = ActiveSheet
    str = Ws.Name

    'Delete all name of the activasheet
    For Each tbname In wok.Names
        'looop in the activeworksheet
        If (InStr(1, tbname.RefersTo, str & "!") > 0 Or InStr(1, tbname.RefersTo, "#REF!") > 0) Then
            tbname.Delete
        End If
    Next

    For b = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas.Count
        ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas(b).Name = "Tableau" & str & b
    Next

    'check
    For Each tbname In wok.Names
        'looop in the activeworksheet
        str = Ws.Name
        If InStr(1, tbname.RefersTo, str & "!") > 0 Then
            'MsgBox tbname.RefersTo
        End If
    Next
End Sub

Answer 6

wouahouuu...

---

The most important in the answer is the question

Answer 7

hi Bernie,

the last code sent is not working in all case. below when i run the code the table is defined as the highlightened row below; Do you know why? For the moment i used the previous code.

regards

---

The most important in the answer is the question

Answer 8

The example I posted was only looking at cells without formulas. Here is how you would do it if you want to have mixed formulas and values:

Sub Activest2()
    Dim b As Integer
    Dim str As String
    Dim wok As Workbook
    Dim tbname As Name
    Dim tbl As ListObject
    Dim Ws As Worksheet
    Dim myAdd As String

    Set wok = ActiveWorkbook
    Set Ws = ActiveSheet
    str = Ws.Name

    'Delete all name of the activasheet
    For Each tbname In wok.Names
        'looop in the activeworksheet
        If (InStr(1, tbname.RefersTo, str & "!") > 0 Or InStr(1, tbname.RefersTo, "#REF!") > 0) Then
            tbname.Delete
        End If
    Next

    For b = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas.Count
        myAdd = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas(b).CurrentRegion.Address
        For Each tbname In wok.Names
            If InStr(1, tbname.RefersTo, myAdd) > 0 Then
                GoTo NameExists
            End If
        Next
        ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas(b).CurrentRegion.Name = "Tableau" & str & b
NameExists:
    Next

    'check
    For Each tbname In wok.Names
        'looop in the activeworksheet
        str = Ws.Name
        If InStr(1, tbname.RefersTo, str & "!") > 0 Then
            'MsgBox tbname.RefersTo
        End If
    Next
End Sub

Answer 9

Sub AllCurrentRegions()

    Dim rngUsedRange        As Range
    Dim rngCurrentRegion    As Range
    Dim rngCell             As Range

    Set rngUsedRange = Sheet1.UsedRange.SpecialCells(xlCellTypeConstants)
    Set rngCurrentRegion = rngUsedRange.Cells(1).CurrentRegion
    
    Call DoSomethingWithCurrentRegion(rngCurrentRegion)
    For Each rngCell In rngUsedRange
        If Intersect(rngCurrentRegion, rngCell) Is Nothing Then
            Debug.Print rngCell.CurrentRegion.Address
            Call DoSomethingWithCurrentRegion(rngCurrentRegion)
            Set rngCurrentRegion = rngCell.CurrentRegion
        End If
    Next
    
End Sub

Function DoSomethingWithCurrentRegion(CurrentRegion As Range)

End Function

---

Rajan Verma [e-mail] IM - Gtalk

Answer 10

Hi Bernie,

thank you for your code. this code is working. According to your code, what i understand is the matter was the system names several time a same table (check if namexist suppose that, as we deleted all the names before), i am right?

My second point was i don't use any formula. Is there any special characters considered as formula by Excel?

in all case, many thanks for your help,

regards

---

The most important in the answer is the question

Answer 11

Hi rajan,

thank you for your reply; :-) the code looks nice but it is not fixed the issue :-).

Regards

---

The most important in the answer is the question

Answer 12

It may have had something to do with merged cells - I really am not sure and would only be able to pinpoint the issue if I had a copy of your file. Since the code works, we'll leave it at that ;-)