Loop each sheet between two sheets

[DataBlake]

so i'm trying to loop between sheets in between my sheets "Program Start" and "ID check"
and if hidden sheets matter it would be between "Program Start" and "Master Image"
i.e the loop logic would be:

for each sheet between ProgramStart to IDcheck
'do a thing
else 'do a thing
next sheet

the reason being as these sheets contain the data i work with but the sheets aren't consistant day to day.
so some days it will be vendor1, vendor 3, vendor 4.
other days it will be all 6 vendors etc

any help would be appreciated

 

[Fluff]

Depending on what you are ultimately trying to do, you could use a dictionary

Sub BlakeSkate()
   Dim i As Long
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   For i = Worksheets("ProgramStart").Index + 1 To Worksheets("IDcheck").Index - 1
      If Sheets(i).Visible = xlSheetVisible Then Dic.Add Sheets(i).Name, Sheets(i)
   Next i
   
   For i = 0 To Dic.Count - 1
      Cells(1, i + 1) = Dic.keys()(i)
   Next i
End Sub

 

[mikerickson]

i get type mismatch on

Set visibleSheets(visibleCount) = Worksheets(i)

i am running excel 2016 on windows 10

My bad, change this declaration, remove the s

Dim visibleSheets() as [COLOR="#FF0000"]Worksheet[/COLOR]

I also forgot to dim OneSheet as Variant and to deal with the x in the Cells line.

 

[DataBlake]

Depending on what you are ultimately trying to do, you could use a dictionary

I'm ultimately trying to do this:
for each sheet sheet in between "Program Start" and "ID check" (that are visible)
loop through column a in the active sheet to find a match in column a of the sheets between program start and id check
if it matches then activesheet D = the matches R

i currently have

Sub autoID()
    
Dim lastRow As Long
Dim datLAST As Long
Dim ws As Worksheet
Dim shtNAME As Variant
Dim sheeter As Long
Dim i As Long
Dim x As Long
Dim p As Long

Set ws = ActiveSheet

' Measure Sheet Distance & Assign Array Size
For sheeter = Worksheets("Program Start").Index + 1 To Worksheets("Master Image").Index - 1
ReDim shtNAME(sheeter - (Worksheets("program start").Index + 1))
Next sheeter

' Define Array Values
For i = Worksheets("Program Start").Index + 1 To Worksheets("Master Image").Index - 1
   shtNAME(i - (Worksheets("program start").Index + 1)) = Worksheets(i).Name
Next i


lastRow = ws.Range("A" & Rows.Count).End(xlUP).Row


For x = LBound(shtNAME) to UBound(shtNAME)
  datLAST = Worksheets(shtNAME(x)).Range("A" & Rows.Count).End(xlUP).Row
    for p = 2 to lastRow
         for i = 2 to datLAST
              
               If ws.Range("A" & p).Value = Worksheets(shtNAME(x)).Range("A" & i).Value Then
                  ws.Range("D" & p).Value = Worksheets(shtNAME(x)).Range("R" & i).Value
              Else
              End If
    Next i
 Next p
Next x

seems to take a long while when you have 60,000+ rows on ws
and 3-6 sheets of shtNAME

I will try dictionary though.

 

[DataBlake]

I also forgot to dim OneSheet as Variant and to deal with the x in the Cells line.

that seems to work effectively
and if i understand correctly onesheet is working as the array?

 

[Fluff]

No idea how long it will take, but how about

Sub BlakeSkate()
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   Dim Res As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   For i = Worksheets("Program Start").Index + 1 To Worksheets("Master Image").Index - 1
      With Sheets(i)
      If .Visible = xlSheetVisible Then Dic.Add Sheets(i), .Range("A1", .Range("A" & Rows.Count).End(xlUp))
      End With
   Next i
   
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      For i = 0 To Dic.Count - 1
         Res = Application.Match(Cl, Dic.items()(i), 0)
         If Not IsError(Res) Then
            Cl.Offset(, 3).Value = Dic.keys()(i).Range("R" & Res).Value
         End If
      Next i
   Next Cl
End Sub

 

[DataBlake]

No idea how long it will take, but how about

i don't understand 80% of what any of that is but holy cow that is remarkable
i'm actually amazed by your seemingly endless knowledge of VBA
still slow, but seems faster than mine.

 

[Fluff]

Do you have any formulae or formatting in cols A:D on the active sheet?

 

[DataBlake]

Do you have any formulae or formatting in cols A:D on the active sheet?

nope. its just a buncha numbers and letters.
column A is a part number: M144478065+47
column B is either a blank cell or an extension identifier: 4TTAC
column C is a listing number: 351115643
column D (which this code grabs from vendor sheets) is a quantity: 14

all of these values are default formatted from a csv(comma delimited) file.
although after this portion of the code runs i insert a formula into E

 

[Fluff]

Untested, but how about

Sub BlakeSkate()
   Dim i As Long, j As Long
   Dim Dic As Object
   Dim Ary As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   For i = Worksheets("Program Start").Index + 1 To Worksheets("Master Image").Index - 1
      With Sheets(i)
      If .Visible = xlSheetVisible Then
         Ary = .Range("A1").CurrentRegion.Value2
         For j = 2 To UBound(Ary)
            If Not Dic.exists(Ary(j, 1)) Then Dic.Add Ary(j, 1), Ary(j, 18)
         Next j
      End If
      End With
   Next i
   With ActiveSheet
      Ary = .Range("A1", .Range("A" & Rows.Count).End(xlUp).Offset(, 3)).Value2
      For i = 2 To UBound(Ary)
         Ary(i, 4) = Dic.item(Ary(i, 1))
      Next i
      .Range("A1").Resize(UBound(Ary), 4).Value = Ary
   End With
End Sub

This assumes that each sheet to be searched has data starting in A1 with at least 18 columns of data

 

[DataBlake]

This assumes that each sheet to be searched has data starting in A1 with at least 18 columns of data

what in the witchcraft ?
i blinked and it was done