VB - Many Sheet Optimization : Happy new years :0.

[guyborchers]

I am having a problem with some VB executing in Excel.

On my development box, 90% of the time it will run in under 40 seconds (which is acceptable, but I'd love to improve upon it.). 10% of the time, it seems if I have a 2nd workbook open, unrelated?, or if perhaps my computer is just slightly busy with something else, antivirus, whatever. it takes 16 minutes. Obviously if I can get 40 seconds down to 3-5 then 16 minutes may drop to 1-2 minutes (worse case), any such gains would be highly welcomed.

What this is doing.

I have a 'quote' sheet, that has many tabs brought in from external sources.

This takes all those tabs (after the initial tabs in the book that remain static) and renames them in order 1 -> (100 now, eventually xxxxx).

It also allows them to reorder those numbered tabs, delete, add, or whatever and then resync causing them to once again go back to the order 1 through 100. (( not by sorting them, but by renaming them to a NEW 1 through 100.)) exaple, 3 sheets, named 1 2 3... move 3 before 1 and 2 and now it says 3 1 2 for tabs. hit sync it will change it back to 1 2 3 with sheet 3 now being sheet 1.


After it renames the tabs, it then goes back to each tab and synchronizes the quantity field, as well as syncing the Estimator sheet to each tab as well.

Finally it goes back to an itemized list sheet and cleans it up as well.

so I guess this is a 3 part process.

I have made small gains optimizing a paticular loop to skip over actions that would be already existing in the 'syncbook()' sub.


I think my biggest overhead for processing is dealing with the data that resides on other sheets, but am lacking a way to speed that up.


for informational purposes, here is my current situation.

worksheet with 60 extra tabs (above and beyond the 8 static), ... takes about 7 seconds to rename all 60 tabs to the proper order. then takes another 25-40 seconds to 'sync' the pages to one another (if disabling the latest optimization to remove redundant actions. )


Here is the first Sub, followed by the second:

Sub rename_tabs()
Dim vArrIn As Variant
Dim vArrIn2 As Variant
Dim vArrOut(100, 100)
myTimer = Timer
'First we need to verify / gauruntee that this whole process will go off without hitch
'Grab snapshot of itemized list sheets order before renaming / reordering tabs
vArrIn = Sheets("LIST").Range("C4:CY103")
'verify there is no duplicate item name, so that we can make sure we will maintain proper quantities when we reorder the sheets


' !must make this not be hardcoded for '100 sheets'
For g = 1 To 100
    test_name1 = vArrIn(g, 1)
    For h = g + 1 To 100
       test_name2 = vArrIn(h, 1)
       If test_name1 = test_name2 And test_name2 <> "" Then
       MsgBox ("There is a Duplicate Item Name present. We must abort.")
       Exit Sub
       End If
    Next h
    
    For Each ws In ThisWorkbook.Sheets
    wsname = ws.name
    ' check for "_" to know if this paticular item belongs to a specific company or branch (specialized)
    If InStr(wsname, "_") Then
       wsnameTemp = Split(wsname, "_")
       wsname = wsnameTemp(0)
    End If
       wsrange = ws.Range("B6").Value
       If UCase(Left(wsname, 3)) = UCase(Left(wsrange, 3)) Then
          For f = 1 To 100
          ' Verify no duplicate name already exists in the book, to avoid diffuculties with reordering the sheets.
              If UCase(wsrange) = UCase(vArrIn(f, 1)) And vArrIn(f, 1) <> "" Then
              MsgBox ("There is a Duplicate Item Name present. (" & UCase(wsname) & ") We must abort.")
              Exit Sub
              End If
          Next f
       End If
    Next ws
    
    
    
Next g


'''


' Finally we will rebuild the List page with the new order of all the sheets, moving the quanities with their respective sheets
Sheets("LIST").Range("C4:C103").ClearContents
For test = 9 To Sheets.Count
   Sheets(test).name = "temp" & test - 8
Next test

temp = 4
For test1 = 9 To Sheets.Count
   Sheets(test1).name = test1 - 8
   Sheets("LIST").Cells(temp, 3) = Sheets(test1).Range("B8").Value
   temp = temp + 1
Next test1

' Fix up that Itemized List Sheet

vArrIn2 = Sheets("LIST").Range("C4:C103")

For i = 1 To 100
   For j = 1 To 100
      If IsEmpty(vArrIn2(j, 1)) Then
         GoTo here:
      End If
      vArrOut(j - 1, 0) = vArrIn2(j, 1)
      If vArrIn(i, 1) = vArrIn2(j, 1) Then
         For k = 1 To 101
            vArrOut(j - 1, k - 1) = vArrIn(i, k)
         Next k
         Count = Count + 1
         GoTo here2:
      End If
   Next j
here:
here2:
Next i

'MsgBox (Count)
Sheets("LIST").Range("C4:CY103").ClearContents
Sheets("List").Range("C4:CY103") = vArrOut

' Perform woorkbook synchronization now
SyncBook
MsgBox (Timer - myTimer)
End Sub

2nd:

Sub SyncBook()

Dim ws As Worksheet
Dim temp As String
Dim name As String
Dim j As Integer
Dim shopCost As String
Dim engCost As String

j = 11

For Each ws In ThisWorkbook.Sheets
    'begin block - not very clean way to avoid working on the 'standard' sheets in the quote
    If ws.name <> "EST" Then
    If ws.name <> "ORDER" Then
    If ws.name <> "LIST" Then
    If ws.name <> "QUOTE" Then
    If ws.name <> "ACCT" Then
    If ws.name <> "ITEMIZED" Then
    If ws.name <> "Item Price" Then
    If ws.name <> "Hidden" Then
    If ws.name <> "ItemPicker" Then
    'end block
       temp = "='" & ws.name & "'!"
       'Sheets(ws.name).Select
       'name = Range("B6").Value
       name = ws.Range("B6").Value
      ' ActiveSheet.Unprotect
      If ws.Range("A8").Formula = "=EST!D" & j Then
      'GoTo skipwrite:
      End If
      
       ws.Unprotect
       'Range("B3").Value = "=EST!D2"
       'Range("B4").Value = "=EST!D3"
       'Range("B5").Value = "=EST!D4"
       'Range("B6").Value = "=EST!I2"
       'Range("A8").Value = "=EST!D" & j
       'Range("I6").Value = "=EST!Q8"
       'Range("I7").Value = "=EST!U8"
       ws.Range("A8").Value = "=EST!D" & j
       
       If ws.Range("B3").Formula = "=EST!D2" Then
        GoTo skipRest:
       End If
       ws.Range("B3").Value = "=EST!D2"
       ws.Range("B4").Value = "=EST!D3"
       ws.Range("B5").Value = "=EST!D4"
       ws.Range("B6").Value = "=EST!I2"
       
       ws.Range("I6").Value = "=EST!Q8"
       ws.Range("I7").Value = "=EST!U8"
skipRest:
       'ActiveSheet.Protect DrawingObjects:=True, contents:=True, Scenarios:=True
       ws.Protect DrawingObjects:=True, contents:=True, Scenarios:=True
  
       ' Somewhere here I want to dynamically grab many of the following variables, based on where
       ' they may actually show up in the sheet.  ( for non static, placement of specific cells. )
    
       'Sheets("EST").Select
       ActiveSheet.Unprotect
       Range("E" & j).Value = temp & "B8"
       Range("H" & j).Value = temp & "I4"
       Range("K" & j).Value = temp & "I5"
       Range("N" & j).Value = temp & "F6"
       Range("R" & j).Value = temp & "F7"
       'travel costs
       Range("V" & j).Value = temp & "I8"
 
       ActiveSheet.Protect DrawingObjects:=True, contents:=True, Scenarios:=True
skipwrite:
        j = j + 1
    'begin block
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    'end block
Next ws


ActiveSheet.Unprotect
tempsheet = 0

For m = j To 100

temptemp = "E" & m
If IsError(Sheets("EST").Range(temptemp).Value) Then
   If tempsheet = 0 Then
   Set NewSheet = Sheets.Add
   sheetname = NewSheet.name
   tes = "=" & sheetname & "!A1"
   Sheets("EST").Range(temptemp).Formula = tes
   tempsheet = 1
Else
   Sheets("EST").Range(temptemp).Formula = tes
End If
ElseIf Sheets("EST").Range(temptemp).Value = "" Then
   GoTo exitCellFixer:
   Else
   If tempsheet = 0 Then
   Set NewSheet = Sheets.Add
   sheetname = NewSheet.name
   tes = "=" & sheetname & "!A1"
   Sheets("EST").Range(temptemp).Formula = tes
   tempsheet = 1
   Else
   Sheets("EST").Range(temptemp).Formula = tes
   End If
   End If

Next m


exitCellFixer:
If tempsheet = 1 Then
Application.DisplayAlerts = False
NewSheet.Delete
Application.DisplayAlerts = True
End If

ActiveSheet.Protect DrawingObjects:=True, contents:=True, Scenarios:=True

ActiveSheet.Unprotect

For k = j To 99
Range("E109:Y109").Copy
'Selection.Copy
temp = "E" & k
Range(temp).Select
If IsError(Range(temp).Value) Then
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Else
GoTo here:
End If


Next k
here:
ActiveSheet.Protect DrawingObjects:=True, contents:=True, Scenarios:=True


End Sub

Thanks in advance for any efforts you contribute and time to read this.

~Guy

 

[guyborchers]

puuh, sometimes you get so into a problem and you forget to see the forest for the trees? or does it go the other way?




adding in

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual



Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

to the front and back of the first VB Sub

has reduced the time from 40 seconds to .75 seconds .



My biggest question, ... is there any risk that the actual formulas will not have been updated properly in each specific sheet and or calculated?

The data must be 'present' and 'active' in this application, and always up to date / accurate.



also, I would still be interested in possible optimizations without the one mentioned above.... if possible, though now I guess it is quite less important in the scheme of things...

Thanks again,

~Guy

 

[guyborchers]

Well... Exactly what I was afraid of, data wise, is happening.

Because calculations are turned off, the 'fix the LIST' routine 2/3 the way down the first macro is not completing as it should... it is pulling stale information.

without calculations turned off it completes as you'd expect.

I tried fudging it a little and throwing in a Forced calculate right between the sections of code where it would need to be done, as well as turning back on calculations, but neither remedied the situation.

if I run the 'new' (turning calculations off) way twice it works as expected.

so I could run it twice (manually) and be done in 2 seconds... but I am not sure this is desireable.

any advice ?

 

[guyborchers]

I actually found where to put it... I was putting it in a little too late, and my data was already stale at that point

Thankfully, adding this little tidbit did VERY little to the overall speed of the macros.

still looking for more optimizations / opinions.

Thanks,
~Guy

temp = 4
For test1 = 9 To Sheets.Count
   Sheets(test1).name = test1 - 8
   Sheets(test1).Calculate
   Sheets("LIST").Cells(temp, 3) = Sheets(test1).Range("B8").Value
   temp = temp + 1
Next test1

 

[Stiles]

I actually found where to put it... I was putting it in a little too late, and my data was already stale at that point

Thankfully, adding this little tidbit did VERY little to the overall speed of the macros.

still looking for more optimizations / opinions.

Hello Guy,

One thing I do notice is you're using a lot of VB loops to do what Excel could do for you more efficiently.

So for example on your "List" sheet, you're checking for duplicate names via a loop g = 1 to 100 with an embedded loop h = g+1 to 100 which works but is ineffcient. For me, I'd rather have error columns on the sheet, hidden away from the user area that check for errors with a single line in the VB code checking for errors

Eg. in hidden range: countif(range,cell) with sum of countif's somewhere on sheet and in VB if sum of countif's > sum of items on list abort. So rather than looping through 100,000 checks to verify if you're duplicating names you could have a single check... I think this is good practice so long as you hide the error checking from the users and lock everything down!

I'm pretty sure you could use this approach elsewhere in your error checking too.

Stiles.

 

[guyborchers]

That will have to be something for me to investigate...

Especially since one of my goals is to get away from static numbered items...

ideally I want my scripts to only care about what actually exists, ie, if there are only 5 sheets, 5 sheets.

if there are 105, i don't want it to just stop working at 100 .


Etc.


I will add this into things to address as I further develop it.



I did realize it was fairly sloppy to use nested if's in such a way, but also realized that the actual time it took to iterate through was rather minimal. However, It is always good to work in best practices as possible.


Thank you for your post.


~Guy