Loop each sheet between two sheets

DataBlake

Well-known Member
Joined
Jan 26, 2015
Messages
781
Office Version
  1. 2016
Platform
  1. Windows
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:

Code:
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
 
Last edited:
Depending on what you are ultimately trying to do, you could use a dictionary
Code:
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
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
i get type mismatch on
Code:
Set visibleSheets(visibleCount) = Worksheets(i)
i am running excel 2016 on windows 10

My bad, change this declaration, remove the s

Code:
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.
 
Upvote 0
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

Code:
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.
 
Upvote 0
No idea how long it will take, but how about
Code:
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
 
Upvote 0
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.
 
Upvote 0
Do you have any formulae or formatting in cols A:D on the active sheet?
 
Upvote 0
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
 
Upvote 0
Untested, but how about
Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,916
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top