How to get sheets Name from index sheet and use them in array with VBA

[allam2002]

I have a Table in sheet "index" with column "Company" and i have a sheet for each company with the same name so i want to create a code with vba to get the companies names from this column and use it in array, i tried this code
Dim DirArray() As Variant
DirArray = Sheets("index").Range("B2:B5").Value
For Each sh In ActiveWorkbook.Sheets(DirArray(1, 1))

but i got an error so what is wrong and if i want to expand the Range limit to the last cell with value,
Can you please help me and if i want to use ListObjects to get the data from this Table can you point me to the right way.

Thank You

 

[mrhstn]

If I understand what you've done so far...

Dim dirArray() As Variant
Dim i As Long


dirArray = Sheets("Index").Range("B2:B5")
For i = LBound(dirArray) To UBound(dirArray)
    With ActiveWorkbook.Sheets(dirArray(i))
        '..... Whatever needs doing
    End With
Next i

 

[allam2002]

Thank you for your help but again i get error "Type mismatch" here is the whole code:
Sub CopyDataWithoutHeaders()
Dim i As Long
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
Dim rngMyUsedRange As Range
Dim rCell As Range
Dim DirArray() As Variant
DirArray = Sheets("index").Range("B2:B5")







With Application
.ScreenUpdating = False
.EnableEvents = False
End With


'Delete the sheet "Alert" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Alert").Delete
On Error GoTo 0
Application.DisplayAlerts = True


'Add a worksheet with the name "Alert"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Alert"
'Fill in the start row
StartRow = 3

lnDestRow = DestSh.Cells(DestSh.Rows.Count, "A").End(xlUp).Row + 1

'loop through all worksheets and copy the data to the DestSh
For i = LBound(DirArray) To UBound(DirArray)
For Each sh In ActiveWorkbook.Sheets(DirArray(i))


'Copy header row, change the range if you use more columns
lnDestRow = lnDestRow + 1
sh.Range("A1:P1").Copy DestSh.Range("A" & lnDestRow)
lnDestRow = lnDestRow + 1
sh.Range("A2:P2").Copy DestSh.Range("A" & lnDestRow)
lnDestRow = lnDestRow + 1


'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)



For Each rCell In sh.Range("I3:I100,L3:L100,M3:M100")



If IsDate(rCell.Value) _
And rCell.Value < Date + 30 Then


sh.Rows(rCell.Row).Copy
With DestSh.Range("A" & lnDestRow)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
lnDestRow = lnDestRow + 1
End If
Next rCell

Next

Next i


ExitTheSub:


Application.Goto DestSh.Cells(1)


'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[mrhstn]

Hmm... Try this

Dim dirArray As Variant
Dim i As Long


dirArray = Sheets("Index").Range("B2:B5")
For i = LBound(dirArray) To UBound(dirArray)
    With ActiveWorkbook.Sheets(dirArray(i, 1))
        ' .... Do something here
    End With
Next i

 

[NoSparks]

You don't indicate which line is giving the 'Type mismatch' error.

Try altering mrhstn's suggestion to

DirArray = Application.Transpose(Sheets("Index").Range("B2:B5").Value)
For i = LBound(DirArray) To UBound(DirArray)
    With ActiveWorkbook.Sheets(DirArray(i))
        ' .... Do something here
        MsgBox .Name
        '
    End With
Next i

 

[allam2002]

Thank you it works

 

[allam2002]

What if i want to expand the range to the last cell that have value not only "B2:B5"

 

[Rick Rothstein]

What if i want to expand the range to the last cell that have value not only "B2:B5"

Instead of specifying the range like this...

Sheets("Index").Range("B2:B5")

specify it like this instead...

Sheets("Index").Range("B2", Sheets("Index").Cells(Rows.Count, "B").End(xlUp))

 

[allam2002]

That also give me "subscript out of range"

 

[Rick Rothstein]

That also give me "subscript out of range"

I am not sure which of the posted codes you are using, so I guessed at the sheet name. The error you are mentioning seems to mean there is no sheet named "Index", so you will need to replace the two Sheets("Index") parts of what I posted with a proper reference to the worksheet you want to grab this range from.