Log in

View Full Version : Solved: Skip Non-Existing Tabs



Hambone
06-04-2013, 01:10 PM
Hello Everyone, With the help of some of you last week I was able to create the following code to collect data from specific tabs. Now that I try to run it a week later I have noticed I don't have tabs for the weekend seeing we don't run production on the weekends. Now I need help is figuring out how to change my String "strSheets" to subtract a number to look for the next available tab. I have Tabs 20130604, 20130603 and 20130531. When strSheets = 20130602 is stops becasue there is no tab.

[/VBA]
Do Until strSheets = "20130528"

Sheets(strSheets).Select
Range("E28:O28").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A3").Select
Selection = strSheets

Rows("3:3").Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Select

Sheets(strSheets).Select

Range("E15:O15").Select
Selection.Copy
Sheets("Sheet1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A3").Select
Selection = strSheets

Rows("3:3").Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

strSheets = strSheets - 1
Loop

Once again any help is appreciated

Tom

rollis13
06-04-2013, 02:48 PM
Have a try with a couple of added lines of script, should do:Sub test()
strSheets = "20130603"
On Error GoTo skip '<== added
Do Until strSheets = "20130528"
Sheets(strSheets).Select
Range("E28:O28").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Selection = strSheets
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Select
Sheets(strSheets).Select
Range("E15:O15").Select
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Selection = strSheets
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
skip: '<== added
strSheets = strSheets - 1
On Error Resume Next '<== added
Loop
End Sub

Hambone
06-04-2013, 02:58 PM
rollis13, thank you for the help. I had to put

On Error Goto skip '<== added


inside the loop to make it work for 20130602; however, when 20130601 was the new value it went back into debug. Should I try to add the "Skip" in another location?

Thanks

rollis13
06-04-2013, 03:38 PM
The code, as added, works if placed in a module. I get the same error if the code is in a sheet code panel.


PS. sorry, not working anymore. Probably I got everything wrong but now it's quite late and need to got to sleep.
Take a look in the Forum at Error Handling to fix your problem.

rollis13
06-05-2013, 10:37 AM
This code placed in a Module is working but must say that the entire macro is not efficient. It will loop needlessly 70 times from 20130601 to 20130531 and at every other change of month.
Option Explicit
Sub test1()
Dim strSheets As String '<== added
strSheets = "20130603"
On Error GoTo SkipTab '<== added
Do Until strSheets = "20130528"
Sheets(strSheets).Select
Range("E28:O28").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Selection = strSheets
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Select
Sheets(strSheets).Select
Range("E15:O15").Select
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
Selection = strSheets
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
strSheets = strSheets - 1
Loop
Exit Sub '<== added
SkipTab: '<== added
strSheets = strSheets - 1 '<== added
Resume '<== added
End Sub

Hambone
06-05-2013, 10:41 AM
Thanks Rollis13, i know it is not efficienct yet. First i need to get what i know to work before i can make it better LOL...

Thanks for your help. I will give it a try to see how it works

Tom

Hambone
06-05-2013, 11:08 AM
Rollis13, this did work even though it counted from 100 to 1. now i need to figure out how to mark this as solved

Thanks,
Tom

HiTechCoach
06-05-2013, 11:33 AM
There is a problem with this:

strSheets = strSheets - 1

It can't handle month changes.

Replace the above with the following:


Dim datSheetDate As Date

datSheetDate = DateValue(Format(strSheets, "0000/00/00"))
Select Case Weekday(datSheetDate)

Case Is = 2
' Monday
strSheets = Format(datSheetDate - 3, "YYYYMMDD")
Case Else
' Tuesday-Friday
strSheets = Format(datSheetDate - 1, "YYYYMMDD")

End Select


It will automatically skip Saturday and Sunday and handle month changes.

rollis13
06-08-2013, 01:14 PM
Glad being of some help :biggrin: .
Note that, if used, HiTechCoach's code will avoid the useless looping.