Sheet Range Object Item List Reorder

Title Changed 03.02.2015 by Alan from
Re: Range Object Hyperlinks(Item) – List order Anomaly


.......Original

Range Object Hyperlinks(Item) – List order Anomaly

Hi,
. Hope this is in the right Sub Forum. (It may border between Basics and Normal or even Advanced)

. I was recently handling large amounts of Hyperlinks using VBA.
. I sometimes had a Spreadsheet Range where all cells contained Hyperlinks. As is Typical practice I “captured” this Range as a Range object. Here a typical exert from such a code:

Sub SpreadsheetRangeCaptureHyperlinkItemOrderBodged() '
Dim wks4 As Worksheet: Set wks4 = ThisWorkbook.Worksheets("CrazyHyperlinkItemOrderBodged") 'Give wks abbreviation Object, Method and Functions of Object Worksheet via enabled Intellisense suggestions after typing "." (Dot) after Object wks1

'Part 1a. The initial "Creating” of One Range Object to include all cells of interest.--------------------
Dim ObjectCapturedRange As Range 'This will be set to One Range Object. Only a Range object is seen so item types can be defined as Range Objects
Set ObjectCapturedRange = wks4.Range("A1").CurrentRegion 'Typical way to capture the Range in one go. Captured Range will be a grid which Inlcudes any cells "connected" to A1. SO IMPORTANT: Keep periphery of required range free. Alternative UsedRange would make a grid catching / Capturing any cell EVER used.

. After doing this I can, for example, pick out the various (attributes? If that is the word??) from the item list of the Hyperlink “bit” inside the one big Range Object. For example, I was interested in obtaining the URL string. By inspection of the contents in the Watch Window shown for my Object”Captured”Range the URL string I wanted was seen to be one of the (“Attributes??) for each Hyperlink Item. A typical code exert then to obtain this would be of the form:

           = ObjectCapturedRange.Hyperlinks(ItemNumber).Address

…. Where ItemNumber is a Whole Number variable


. After many frustrating hours after getting weird mixed up order listings I identified that the Item list Order is somewot weird:

. I attempt to demonstrate this graphically as best I can:

. If this is a spreadsheet range of Hyperlinks:

-	A	B	C
1	Link 1	Link 8
2	Link 2	Link 9
3	Link 3	Link 10
4	Link 4	Link 11
5	Link 5	Link 12
6	Link 6	Link 13
7	Link 7	Link 14
8

..... then this is the corresponding order of the Items held within the Range Object:

Item 7

Item 1

Item 2

Item 3

Item 4

Item 5

Item 6

Item 14

Item 8

Item 9

Item 10

Item 11

Item 12

Item 13

. Once I realized this I was able to “Bodge” my way around it.
. But my 3 main Questions.

. 1) Could experienced users confirm for me that this is (always) the case and point me in the direction of any literature confirming this.

. 2) Is there some way to change the default order to something more sensible?


. I ask these questions as I am very inexperienced and am somewot wary of using something which appears to behave in a very peculiar way. I am therefore not sure if it would always do it in this way.
. I note for example that in the same Range object I may obtain the name of the link through the Property using something of the form
. .Value2(Row , Column)
. --- .. in this case the Values2() are held in an Array which looks identical both in size and order to the how the Spreadsheet Range A1 to B7 looks.

(. 3) Just something minor I noticed in passing. In the Watch Window it appears that the number of items are Limited to 256. However, my final macro is working to date for over a thousand Hyperlinks. And Indeed in the Watch Window Values2 does not appear to be so limited. Can someone confirm that the limit is above 256? )


. So basically I am looking for some clarity from someone who has more in depth knowledge of how VBA is working on how / why this peculiar order is used and if I can rely on it always being so...

. Many Thanks
Alan Elston.

P.s. If it helps I enclose the file where I was investigating this strange Anomaly with a small sample of data.
https://app.box.com/s/2ehgbdysv6uilc0g7z7jxi3t6xvw6njt
. There are 5 sheets.
. For each sheet there is one macro in each Sheet Module.
. In the Final 2 Sheets I have a done a somewot crude “Bodge” to give me an Output URL string Array in the same order as the Captured Spreadsheet Hyperlink Range. – If BTW any Profi has a more professional solution for bringing out the URL strings in the correct order (for me “correct” here which would be the order correspond to the order of the Spreadsheet Range) then I would very much appreciate a copy of such a code.


. The Final Code I wrote for example might be a start point for anyone requiring a quick solution to such a problem..
. It will take this arbitrary range

	B	C
2	Apple fresh	Apfel
3	'Bierwurst' (coarse heat-treated sausage in bladder and smo	"Cordon bleu" vom Schwein, bofrost
4	'Breslauer' Lyonaise	"Peperonata" Paprikazubereitung Vogeley GV
5	'Gaisburger Marsch' (potatoes with beef) (1)	"Pomona" Tomtenpüree-Konzentrat Vogeley GV

and after running the macro “SpreadsheetRangeCaptureHyperlinkItemOrderBodged2()” it will give the outputted URL strings, in this form and correct order

	A	B
17	http://www.ernaehrung.de/lebensmittel/en/F110100/Apple-fresh.php	http://www.ernaehrung.de/lebensmittel/de/F110000/Apfel.php
18	http://www.ernaehrung.de/lebensmittel/en/W255400/%27Bierwurst%27-%28coarse-heat-treated-sausage-in-bladder-and-smo.php	http://www.ernaehrung.de/lebensmittel/de/BOFRO1287/Cordon-bleu-vom-Schwein,-bofrost.php
19	http://www.ernaehrung.de/lebensmittel/en/W231100/%27Breslauer%27-Lyonaise.php	http://www.ernaehrung.de/lebensmittel/de/VOGEL15805/Peperonata-Paprikazubereitung-Vogeley-GV.php
20	http://www.ernaehrung.de/lebensmittel/en/X468713/%27Gaisburger-Marsch%27-%28potatoes-with-beef%29-%281%29.php	http://www.ernaehrung.de/lebensmittel/de/VOGEL15807/Pomona-Tomtenpueree-Konzentrat-Vogeley-GV.php

Code:

Option Explicit
Sub SpreadsheetRangeCaptureHyperlinkItemOrderBodged2() '

Dim wks5 As Worksheet: Set wks5 = ThisWorkbook.Worksheets("CrazyHyperlinkItemOrderBodged2") 'Give wks abbreviation Object, Method and Functions of Object Worksheet via enabled Intellisense suggestions after typing "." (Dot) after Object wks1
'##### Change Sheet Reference above to suit your Sheet

'Part 1a. The initial "Creating" One Range Object to include all cells of interest.--------------------
Dim ObjectCapturedRange As Range 'This will be set to One Range Object. Only a Range object is seen so item types can be defined as Range Objects
Set ObjectCapturedRange = wks5.Range("B2").CurrentRegion 'Typical way to capture the Range in one go. Captured Range will be a grid which Inlcudes any cells "connected" to A1. SO IMPORTANT: Keep periphery of required range free. Alternative UsedRange would make a grid catching / Capturing any cell EVER used.
'##### Change B2 above to suit your start cell
Dim OutputTableRow As Long, OutputTableColumn As Long 'Bound Loop Count Variables for Output Table..  ......  http://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html
Dim LastRowTableOutput As Long: Let LastRowTableOutput = ObjectCapturedRange.Rows.Count 'We wish to loop below through items in the Object Range Capture Array and put coresponding determined..
Dim LastColumnTableOutput As Long: Let LastColumnTableOutput = ObjectCapturedRange.Columns.Count '... URL Strings in an output array, so we use this convenient Count Property to get the Dimensions then required for a Pre(RE)dimensioined Array

'Part 1b Array for URL Strings. Determined by looping through items in ObjectCapturedRange
Dim HyperlinkUrlValuesArray() As Variant 'This will be an  Array of Values but must be Dimensioned as variant as in the assigning below it will see a Range Object Initially from which the Hyperlink item  property returns the string values. (So Dimensioning to String will not work: jindon   http://www.excelforum.com/excel-programming-vba-macros/1058171-return-row-index-and-column-index-of-a-cell-in-a-range.html  )
ReDim HyperlinkUrlValuesArray(1 To LastRowTableOutput, 1 To LastColumnTableOutput) 'ReDim must be used as DIM only takes actual numbers, not variables. We have the info now to fill in our Array of RangeObjects by looping
Dim ItemNumber As Long: Let ItemNumber = 0 'In ObjectCapturedRange the hyperlinks are listed in a long sequential List. As we assign by looping for the outpüut Array URL string values we need a sequential count
    For OutputTableColumn = 1 To LastColumnTableOutput Step 1  'take each colunn (as the items are grouped in column sequentailly tacked on to eachother......
        For OutputTableRow = 1 To LastRowTableOutput Step 1  '... go along (down) each row, but miss out the first
        Let ItemNumber = ItemNumber + 1
            If OutputTableRow = 1 Then 'For the first Output table row we need the item at the end, that is to say, offset by the Captured range row number -1
            Let HyperlinkUrlValuesArray(OutputTableRow, OutputTableColumn) = ObjectCapturedRange.Hyperlinks(ItemNumber - 1 + LastRowTableOutput).Address
            Else 'For all other Output table rows the item we want is one item back
            Let HyperlinkUrlValuesArray(OutputTableRow, OutputTableColumn) = ObjectCapturedRange.Hyperlinks(ItemNumber - 1).Address
            End If
        Next OutputTableRow
    Next OutputTableColumn
'End Part 1-------------------------------------------------------------------------------------------

'Part 2 Output URL String Arrays To New range----------
Let wks5.Range("A17").Resize(LastRowTableOutput, LastColumnTableOutput).Value = HyperlinkUrlValuesArray() 'Neat way to output results in one go: resize the output start cell to the size of the Array with required output then equate that new range of values to that Array

'End Part 2---------------------------------

I will admit that my eyes went a little crossed looking at your lengthy post, so I didn't study it extensively, but it might help to make sure you understand that if your code goes through a sheet's (or range's) hyperlinks collection by item number, it will return them in the order they were added to the sheet. So if the 1st hyperlink added to the sheet was in A4, that will be Activesheet.hyperlinks(1). If the 2nd was added in A3, that will be Activesheet.hyperlinks(2), etc. However, if you loop through the range a cell at a time (rather than the full range), you would get the hyperlinks in the order in which you process the cells (cells(3,1).hyperlinks(1); cells(4,1).hyperlinks(1), etc.). Hope that helps!

Hi, Have no real Problem currently here, rather Just feeding back a couple of small bits of info :--
(BTW I am currently using XL 2007)
. 1). Just wanted to mention in passing that I noticed empirically that my hyperlink limit per Excel Spreadsheet was about 65530. I have not yet*** found specific written confirmation of this anywhere yet, but in searching I find many people have noticed similar limits. So I guess this is about the limit.
. As a result of this limit I had a problem using my last code for reorganizing a row of approx 33928 Hyperlinks.. This is because the code as written copies the re-ordered item Range into an offset range of similar dimension. Hence I am effectively trying to have 67586 ( = 33928 x 2 ) Hyperlinks at once on the sheet which aint possible. So after item 31602 of the new resorted list, (=67586 – 33928 or ( 33928OriginalList + 31602NewSortedList = 65530 )) items ( rows in my current case), I only get values not hyperlinks put in the reordered range. I did a Simple mod to get the full 65530 available for the new offset Range Reordered List. That was simply to add a line after the offset paste to delete the Original source range list.
. 2). I thought I was being clever and using the very last column in the spreadsheet as a temporary column (To assist getting Unique keys and / or highlighting Duplicate cells). I found in the practice that for large files this sometimes seemed to cause some weird resource issue errors when trying to delete Columns. Worth bearing in mind to consider sometimes using a spare column “just off screen” Maybe instead.

. In next Post (# 9) a modified code reflecting the above..
. P.s.1. I confirmed the limit using various simple copy paste variations manually and in code. So I do not think it is an Object or Microsoft Scripting Runtime Dictionary limit.
***. P.s.2. if anyone in the know, knows more about this limit then I am sure it would be an enrichment to this Thread and enlighten me / anyone else looking in the Future here..

Alan

Code: corresponding to last Post (….#8)
Code: (Note as before Purple bits for notes on how to modify for your File)

'Explanations Here : Post # 10   http://www.mrexcel.com/forum/excel-questions/832103-using-microsoft-scripting-runtime-dictionary-store-then-retrieve-range-objects.html?&&
Sub ScriptingRuntimeDictionaryToStoreRangesAndReOrderItemsKyle2G() '             http://www.mrexcel.com/forum/excel-questions/832103-using-microsoft-scripting-runtime-dictionary-store-then-retrieve-range-objects.html?#post4062236
On Error GoTo TheEnd '**I added this after problems in particular with the Big German Lists to try and be sure that things were turned off
Dim wksLkUp As Worksheet: Set wksLkUp = ThisWorkbook.Worksheets("LeftSpeedsDeutsch") 'Give Abbreviation the Under objects, Methods and Properties of Object Worksheets (Intellisense then gives suggestions through use of . Dot
  wksLkUp.Activate: wksLkUp.Cells(1).Select 'See and select first cell in the sheet for reorganising item order. This line was mostly not always necessary, but occasionally was needed, at least the first time around. (Convention for one cell() argument is L to R first row, then next row down etc.. This one argument convention is not taken as (1 , 1))
Dim rcell As Range: Set rcell = wksLkUp.Range("E21") 'Any cell in required Range. Note the perimeter of this range should be free, that is to say cells touching this range should be empty###, or the CurrentRegion will catch it. Note also a s useful mod here for empty cells: Post #12 #13  http://www.mrexcel.com/forum/excel-questions/213591-pipe-delimited-files-2.html
'##### Change Sheet Reference and reference Cell above to suit your Range
 
'1a) Part 1a. The initial "Creating" One Range Object to include all cells of interest mainly to get grid size info
Dim ObjectCapturedRange As Range 'This will be set to One Range Object. Only a Range object is seen so item types can be defined as Range Objects
Set ObjectCapturedRange = rcell.CurrentRegion 'Typical way to capture the Range in one go. Captured Range will be a grid which Inlcudes any cells "connected" to rcell. SO IMPORTANT: Keep periphery of required range free###. Alternative UsedRange would make a grid catching / Capturing any cell EVER used. Note also
Dim OutputTableRow As Long, OutputTableColumn As Long 'Bound Loop Count Variables for Output Table..  ......  http://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html
 
Dim StartRowTableOutput As Long: Let StartRowTableOutput = rcell.Row 'We wish to loop below through items in the Range Capture. For conveniebce use the Row and Column property of our user given
Dim StartColumnTableOutput As Long: Let StartColumnTableOutput = rcell.Column 'Reference cell to obtain Start Rows and start Columns.
Dim LastRowTableOutput As Long: Let LastRowTableOutput = StartRowTableOutput + ObjectCapturedRange.Rows.Count - 1 'Simaly the last cell in looping can for convenience be obtained once we have the grid size (Row..
Dim LastColumnTableOutput As Long: Let LastColumnTableOutput = StartColumnTableOutput + ObjectCapturedRange.Columns.Count - 1 '...and column Couct) obtained from those Properties of a single "Capture" Range Object
'End part 1a. Info obtained for Spreadsheet range sizes--------------------------------------------------------
 
' 1b)  'Part 1b: Setting up Scriptimg Runtime Stuff-----------------------------
' Attempting Using the Microsooft Scripting Runtime Dictionary to store Range Objects
 
'We put the unique values now into a Dictionary for later look up purposes:
'--requires library reference to MS Scripting Runtime (Early Binding)-
'        Tools>>References>>scrolldown and check the box next to Microsoft Scripting Runtime
'  ..Or crashes at next line.....
 Dim dicLookupTable As Scripting.Dictionary 'Data held with a unique "Key"or Part Number.
 Set dicLookupTable = New Scripting.Dictionary
' The next two lines are an alternative called Late binding. (But note some Dictionary methods and properties( Such as at the end ####) will not work with it  - in those cases Early Binging must be used.
'        Dim dicLookupTable As Object
'        Set dicLookupTable = CreateObject("Scripting.Dictionary")
' Late Binding is better when sharing files as I am here. Early Binding has the advantage that Excel intellisense
' will then work for the Microsoft Scripüting Runtime stuff and give you suggestions after you type the .dot thing
 
     dicLookupTable.CompareMode = vbTextCompare 'Not quite sure wot this does yet
 
'.  A Dictionary in VBA is a collection of objects :you can store all kinds of things in it.
'.  Every item in a Dictionary gets its own unique key, a very important characteristic. A Dictionary can only contain unique keys. That's why you can use the property .keys to create a list of unique strings, numbers or dates.
'.  (Although the Dictionary has not been designed for that purpose it's a nice side effect.)
 
'End of Part 1b initial set up Of Scripting Runtime------------------------
 
 Dim i As Long, j As Long  'LoopBoundVariableCounts used in looping here and at end-----Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster.
 Dim TempColumn As Long: Let TempColumn = Columns.Count: Let TempColumn = 6  'Usually when not debugging comment out last let so Temp Column is last in sheet given by Columns.count....
 Dim TempCell As Range: Set TempCell = wksLkUp.Cells(1, TempColumn): Dim TempCellOffset As Long: Let TempCellOffset = 0 '....We choose a cell (or through the later use of the offset step down a column) to use for Duplicate or Empty cells. We often use the last column in the sheet. (This is genarally a good practice as it will not effect finding last column with .End(XltoLeft). Note there were sometimes strange resource problems with deleting columns on large files using the last column rather than one "just off screen" instead )
 '2a) Part2a) Looping to put Range Objects in MRSD
    For i = StartColumnTableOutput To LastColumnTableOutput Step 1
        For j = StartRowTableOutput To LastRowTableOutput Step 1
          If wksLkUp.Cells(j, i).Value <> "" Then 'If cell is not empty then...
               If Not dicLookupTable.Exists(wksLkUp.Cells(j, i).Value) Then 'check that the unique value does not already exist. ##NOTE
                  dicLookupTable.Add wksLkUp.Cells(j, i).Value, wksLkUp.Cells(j, i) 'it is easier to understand as well as kind of explicit the first argument does a CStr and the Second Takes anything
               Else 'If the key exists, that is to say we have a Range with a Duplicate value, we give the key a slightly modified (unique value) , still give the Range Object as an item, but make an indication, here by highlighting the cell in Pink
               Let TempCellOffset = TempCellOffset + 1
               Let TempCell.Offset(TempCellOffset, 0).Value = "Duplicate at   " & j & " | " & i & ""
               wksLkUp.Cells(j, i).Interior.Color = 10987519
               dicLookupTable.Add TempCell.Offset(TempCellOffset, 0).Value, wksLkUp.Cells(j, i) 'In case of duplicate we need a unique key, but we stillinclude the Duplicate Range
               End If
           Else 'Case fo an empty cell - inform of empty cell by writing message in that cell via the Tempory cell
           Let TempCellOffset = TempCellOffset + 1 'Go to next free tempory cell in tempory column
           Let TempCell.Offset(TempCellOffset, 0).Value = "Empty Cell at   " & j & " | " & i & ""
           dicLookupTable.Add TempCell.Offset(TempCellOffset, 0).Value, TempCell.Offset(TempCellOffset, 0)
           End If
        Next j
    Next i
'End Part 2
 
 '3) Part 3)--transfer range objects from dictionary to array of ranges in one go!!
 Dim rResults() As Variant ' See Question 2) Post #3 and then Further Question 2) Posts #4 and #5 and ?  http://www.mrexcel.com/forum/excel-questions/832103-using-microsoft-scripting-runtime-dictionary-store-then-retrieve-range-objects.html?#post4059199
 Let rResults() = dicLookupTable.Items() 'Note this gives automatically the 0 to ..   convention in rResults Array!
 'End part 3)
 
 '--confirm range objects were transfered to array of ranges with various methods
 Dim MSRDindex As Long: Let MSRDindex = 0 'LoopBoundVariableCounts for Item number of MSRD
    For i = StartColumnTableOutput To LastColumnTableOutput Step 1
        For j = StartRowTableOutput To LastRowTableOutput Step 1
             Let MSRDindex = MSRDindex + 1 'Next item numbe from MSRD
'                    With rResults(MSRDindex - 1) 'Jerry Sullivan Demo for example entire range full with Hyperlinks
'                       wksLkUp.Cells(j, i).Offset(0, 4).Value = .Address & ">" & .Row & ">" & .Value & ">" & .Hyperlinks(1).Address
'                    End With
'             rResults(MSRDindex - 1).Copy Destination:=wksLkUp.Cells(j, i).Offset(0, 4) '
'
             rResults(MSRDindex - 1).Copy
             wksLkUp.Cells(j, i).Offset(0, -4).PasteSpecial Paste:=xlPasteAllUsingSourceTheme 'These 2 lines may be better Preferably to ensure that VBA...'.....guesses or here rather chooses the correct version from the Clipboard which includes all the full Range Info.   Post #6 here -  http://www.mrexcel.com/forum/excel-questions/828241-visual-basic-applications-autofilter-specialcells-xlcelltypevisible-copy-only-values-not-formulas.html
             wksLkUp.Cells(j, i).ClearContents 'if you do this then you are able to make full use of about 65530 hyperlink sheet number limit ' (.. from speed measurements on Acer Aspire 4810TZGfor a Row of 33928 Hyperlinks took to reorder 657s with the extra ClearContents and 500s with just Copy and Paste (If you do the ClearContents at the end of the program you will ofcourse not be able to use the full 65530 )
        Next j
    Next i
 
 Set dicLookupTable = Nothing 'Genarally good practice to turn these thimgs off. 'May not be needed but to keep program flexible should alterations need it.
 Exit Sub 'End assuming no errors occurred
TheEnd: 'End here if errors occurred**. This ensures importent closing things are done even in the case of an err0r
 Application.ScreenUpdating = True
 Set dicLookupTable = Nothing
 MsgBox Err.Description 'Last action before stoping when error occurs:- Give error description in a Message Box.
End Sub 'ScriptingRuntimeDictionaryToStoreRangesAndReorderItemsKyle2
'
'

Hi,
.. This is just a quick feedback, for my Future reference, if no one else’s...
. This Thread was concerned with the Issue of item list number in VBA.
. In particular how the Item order comes about.
. Somewhere along the way the statement was given ( in the absence of finding any concrete documentation ) that....

.. “ Item List number reflects the order in which things are out in “ . It certainly seemed to be the case for adding things into a spreadsheet. And a few experienced people have told ma that that is a general rule!!
.
. I just found along the way a discrepancy, so thought I would note it here.

. ....
. 1 ) If I Add a sheet to a workbook, that general rule does not seem too apply
.
. 2 ) If I move a sheet tab, manually dragging it, or with a code line ) similarly that general rule does not seem too

Rather than labour the verbal Description of what happens, you can run or work through with F8 the first of the codes given below on a fresh Sheet ( Assuming you have XL2007 or XL 2010 which strats with having 3 sheets. )


. The Bottom line is that you can manipulate the item number of Worksheets by
. - ... where they are
. rather than
. - ... when you add them,
. or
. - ... by moving them ( manually or by code)
.
. At the end of the day , The item order for sheets is determined by what you see in the tab list at the bottom of the sheet , starting at item number 1 at the left and increasing as you go to the right.

. As always, any Profi input, such as any documentation explaining how the item number is determined for different things would be welcome. But i expect I have hit on another one of those things that nobody knows for sure or ever thought to document..... ( At least the last code I give, necessary to reorganise the item lists for a sheet, is considerable simpler than that for the ( Hyperlink ) items in a sheet... that is to say for the simple example given here...I will probably post again with a more general code ....later.. ......)


Alan.

Demo Codes:

Sub SheetItemNumbers()
5 Dim Cnt As Long
10 Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 'Original Sheets in my XL2007
20 Dim wb As Workbook: Set wb = ThisWorkbook ' This Workbook
30 Set ws1 = wb.Worksheets("Sheet1"): Set ws2 = wb.Worksheets("Sheet2"): Set ws3 = wb.Worksheets("Sheet3")
'Original Order
40      For Cnt = 1 To 3 Step 1
50      MsgBox "Worksheet item" & Cnt & " is currently " & wb.Worksheets.Item(Cnt).Name
60      Next Cnt
'
'Add sheet at end with name Sheet4
70 wb.Worksheets.Add(After:=wb.Worksheets.Item(wb.Worksheets.Count)).Name = "Sheet4"
80 Dim ws4 As Worksheet: Set ws4 = wb.Worksheets("Sheet4")
90 MsgBox "You added a sheet and named it " & """" & "Sheet4" & """" & " After " & vbCr & "the last sheet item" & vbCr & " .  It has the item number " & ws4.Index
'Recheck order
100     For Cnt = 1 To 4 Step 1
110     MsgBox "Worksheet item" & Cnt & " is currently " & wb.Worksheets.Item(Cnt).Name
120     Next Cnt
'Add a further sheet with name Sheet5
130 wb.Worksheets.Add
140 ActiveSheet.Name = "Sheet5"
150 Dim ws5 As Worksheet: Set ws5 = ActiveSheet
160 MsgBox "You added a sheet and named it " & """" & "Sheet5" & """" & " It " & vbCr & "came in at the 4th tab from the left, second from last" & vbCr & " .  It has the item number " & ws5.Index
170
'Recheck order
180     For Cnt = 1 To 5 Step 1
200     MsgBox "Worksheet item" & Cnt & " is currently " & wb.Worksheets.Item(Cnt).Name
210     Next Cnt
'
'Add sheet at Before sheet2 with name Sheet6
220 wb.Worksheets.Add(before:=wb.Worksheets("Sheet2")).Name = "Sheet6"
230 Dim ws6 As Worksheet: Set ws6 = ActiveSheet
240 MsgBox "You added a sheet and named it " & """" & "Sheet6" & """" & " Before " & vbCr & "the last " & """" & "sheet2" & """" & "" & vbCr & " .  It has the item number " & ws6.Index
'Recheck order
260     For Cnt = 1 To 6 Step 1
270     MsgBox "Worksheet item" & Cnt & " is currently " & wb.Worksheets.Item(Cnt).Name
280     Next Cnt
'
'Move the position of a sheet, fo example shift the tab "Sheet1"
300 wb.Worksheets("sheet1").Move After:=wb.Worksheets(wb.Worksheets.Count)
310 MsgBox "You just moved Sheet1 to the " & vbCr & "last ( tab looking from the left ) that you see"
'Recheck order
320     For Cnt = 1 To 6 Step 1
330     MsgBox "Worksheet item" & Cnt & " is currently " & wb.Worksheets.Item(Cnt).Name
340     Next Cnt
350
'Delete added sheets by last name character > 3
360 MsgBox "The added sheeets will now be deleted"
370 Call AndrewPoulsomAddedSheetsDeleteBackwardloop
'
'ReOrder tabs to original order by
390 MsgBox "The Sheets will be put back into original item order"
400 Call PutSheitsbackInOrder
410

End Sub
Sub SheetItemOrdeCheck()
5 Dim Cnt As Long
10
20 Dim wb As Workbook: Set wb = ThisWorkbook ' This Workbook
30 'Ccheck Order
40      For Cnt = 1 To wb.Worksheets.Count Step 1
50      MsgBox "Worksheet item" & Cnt & " is " & wb.Worksheets.Item(Cnt).Name
60      Next Cnt
'

End Sub
'
'http://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop.html
Sub AddedSheetsDeleteForwardloop() 'Forard Loop requires bodges as deleting tabs upsets count order
Dim wb As Workbook: Set wb = ThisWorkbook ' This Workbook
Dim Cnt As Long
    For Cnt = 1 To wb.Worksheets.Count
        If Cnt > wb.Worksheets.Count Then Exit For 'In the above line the Stop Count is set at the start of the Loop, it is not reevaluated there, but it is here and so we exit if there are no more sheets other than the original
        If Mid(wb.Worksheets.Item(Cnt).Name, 6, (Len(wb.Worksheets.Item(Cnt).Name) - 5)) > 3 Then 'any number
        'If Right(wb.Worksheets.Item(Cnt).Name, 1) > 3 Then' For numbers 1  to 9
        Application.DisplayAlerts = False
        wb.Worksheets.Item(Cnt).Delete
        Application.DisplayAlerts = True
        Let Cnt = Cnt - 1 'After deleting we would "skip a sheet" in the next loop, so we correct with the cardinal sin of changing the Loop Bound variable count in the loop. Sorry shg
        Else
        End If
    Next Cnt
End Sub
'
Sub AndrewPoulsomAddedSheetsDeleteBackwardloop() 'Deletes the current last sheet in the loop and has the advantege then of not upsetting order of Count
Dim wb As Workbook: Set wb = ThisWorkbook ' This Workbook
Dim Cnt As Long
    For Cnt = wb.Worksheets.Count To 1 Step -1
        If Mid(wb.Worksheets.Item(Cnt).Name, 6, (Len(wb.Worksheets.Item(Cnt).Name) - 5)) > 3 Then 'any number
        'If Right(wb.Worksheets.Item(Cnt).Name, 1) > 3 Then' For numbers 1  to 9
        Application.DisplayAlerts = False
        wb.Worksheets.Item(Cnt).Delete
        Application.DisplayAlerts = True
        Else
        End If
    Next Cnt
End Sub
'
Sub PutSheitsbackInOrder() 'Based on Number in last character of Sheet name : Sheet 78 would be reorganised to item number 78, assuming you had 78 sheets
Dim wb As Workbook: Set wb = ThisWorkbook ' This Workbook
Dim Cnt As Long
    For Cnt = 1 To wb.Worksheets.Count
        If wb.Worksheets("Sheet" & Cnt & "").Index <> Cnt Then
        wb.Worksheets("Sheet" & Cnt & "").Move before:=wb.Worksheets.Item(Cnt)
        Else
        End If
    Next Cnt
End Sub