The very last if statement in the code moves value BB41 to BB37 to the new sheet and it stopped working when i went into the new month of may, got me stumped, my sheet number is only up to 57. Hope someone can help?
Sub add_new_sheet()
Dim maxnumber As Integer
Dim maxdate As Date
'scan sheet names and find maximum sheet number and maximum date
maxnumber = 0
maxdate = "01 jan 1970"
templatefound = False
For sheetno = 1 To Sheets.Count
strg = Sheets(sheetno).Name
If UCase(strg) = "TEMPLATE" Then templatefound = True
openbracketpos = InStr(1, strg, "(")
If openbracketpos > 7 And Right(strg, 1) = ")" And UCase(Left(strg, 3)) <> "TEM" Then
numberstrg = Right(strg, Len(strg) - openbracketpos)
numberstrg = Left(numberstrg, Len(numberstrg) - 1)
If Abs(numberstrg) > maxnumber Then
maxnumber = Abs(numberstrg)
previousname = strg
End If
datestrg = Left(strg, openbracketpos - 2)
datemonth = Abs(Left(datestrg, InStr(1, datestrg, "-")))
dateday = Abs(Mid(datestrg, InStr(1, datestrg, "-") + 1, Len(datestrg) - (InStr(1, datestrg, "-") + 3)))
dateyear = Abs(Right(datestrg, 2))
If dateyear > 50 Then dateyear = 1900 + dateyear Else dateyear = 2000 + dateyear
If maxdate < DateSerial(dateyear, datemonth, dateday) Then maxdate = DateSerial(dateyear, datemonth, dateday)
End If
Next
'if no sheet found with valid date and number then fail routine
If maxnumber = 0 Then GoTo no_existing_sheet
'if no template sheet was seen in the scan then fail routine
If templatefound = False Then GoTo no_template
'work out what the new sheet name should be...
newsheetname = Month(maxdate + 1) & "-" & Day(maxdate + 1) & "-" & Right(Year(maxdate + 1), 2)
'prompt the user to ask if this is correct...
newsheetname = InputBox("Is this the correct next date?" & Chr(13) & Chr(13) & _
"If so then click OK, otherwise change it first.", "Add New Date", newsheetname)
If newsheetname = "" Then Exit Sub
'append new number to date
newsheetname = newsheetname & " (" & (maxnumber + 1) & ")"
'check that sheet name does not already exist...
For sn = 1 To Sheets.Count
If Sheets(sn).Name = newsheetname Then GoTo sheet_exists
Next
'create new sheet and name it
Sheets("template").Copy After:=Sheets(Sheets.Count)
Sheets("template (2)").Name = newsheetname
Sheets(newsheetname).Visible = True
'insert new date and number to sheet
Range("ba1").Value = Month(maxdate + 1) & "/" & Day(maxdate + 1) & "/" & Right(Year(maxdate + 1), 2)
Range("az5").Value = maxnumber + 1
'copy contract number and title & location from previous sheet
Range("b8:aw8").Value = Sheets(previousname).Range("b8:aw8").Value
Range("b18:at31").Value = Sheets(previousname).Range("b18:at31").Value
Range("b185:aq243").Value = Sheets(previousname).Range("b185:aq243").Value
'run subroutine to carry cumulative totals through sheets
carry_totals_through
Exit Sub
'ERROR MESSAGES...
no_existing_sheet:
MsgBox "This operation could not be completed as there are no " & Chr(13) & _
"existing sheets of valid name from which to follow." _
, vbCritical + vbOKOnly, "Failed!"
Exit Sub
no_template:
MsgBox "This operation could not be completed as there is no " & Chr(13) & _
"template included in this workbook." _
, vbCritical + vbOKOnly, "Failed!"
Exit Sub
sheet_exists:
MsgBox "This operation could not be completed as there is " & Chr(13) & _
"already a sheet of this date in this workbook." _
, vbCritical + vbOKOnly, "Failed!"
End Sub
Sub carry_totals_through()
maxnumber = 0
minnumber = 999999
For sheetno = 1 To Sheets.Count
strg = Sheets(sheetno).Name
openbracketpos = InStr(1, strg, "(")
If openbracketpos > 8 And Right(strg, 1) = ")" And UCase(Left(strg, 3)) <> "TEM" Then
numberstrg = Right(strg, Len(strg) - openbracketpos)
numberstrg = Left(numberstrg, Len(numberstrg) - 1)
If Abs(numberstrg) > maxnumber Then maxnumber = Abs(numberstrg)
If Abs(numberstrg) < minnumber Then minnumber = Abs(numberstrg)
End If
Next
If maxnumber = 0 Or minnumber = 999999 Or maxnumber = minnumber Then Exit Sub
For sheetpos = minnumber To maxnumber
numberstrg = "(" & sheetpos & ")"
For sheetno = 1 To Sheets.Count
strg = Sheets(sheetno).Name
If Right(strg, Len(numberstrg)) = numberstrg Then
If sheetpos > minnumber Then
Sheets(sheetno).Range("BB37").Value = carrytotal
End If
carrytotal = Sheets(sheetno).Range("BB41").Value
End If
Next
Next
End Sub
Sub add_new_sheet()
Dim maxnumber As Integer
Dim maxdate As Date
'scan sheet names and find maximum sheet number and maximum date
maxnumber = 0
maxdate = "01 jan 1970"
templatefound = False
For sheetno = 1 To Sheets.Count
strg = Sheets(sheetno).Name
If UCase(strg) = "TEMPLATE" Then templatefound = True
openbracketpos = InStr(1, strg, "(")
If openbracketpos > 7 And Right(strg, 1) = ")" And UCase(Left(strg, 3)) <> "TEM" Then
numberstrg = Right(strg, Len(strg) - openbracketpos)
numberstrg = Left(numberstrg, Len(numberstrg) - 1)
If Abs(numberstrg) > maxnumber Then
maxnumber = Abs(numberstrg)
previousname = strg
End If
datestrg = Left(strg, openbracketpos - 2)
datemonth = Abs(Left(datestrg, InStr(1, datestrg, "-")))
dateday = Abs(Mid(datestrg, InStr(1, datestrg, "-") + 1, Len(datestrg) - (InStr(1, datestrg, "-") + 3)))
dateyear = Abs(Right(datestrg, 2))
If dateyear > 50 Then dateyear = 1900 + dateyear Else dateyear = 2000 + dateyear
If maxdate < DateSerial(dateyear, datemonth, dateday) Then maxdate = DateSerial(dateyear, datemonth, dateday)
End If
Next
'if no sheet found with valid date and number then fail routine
If maxnumber = 0 Then GoTo no_existing_sheet
'if no template sheet was seen in the scan then fail routine
If templatefound = False Then GoTo no_template
'work out what the new sheet name should be...
newsheetname = Month(maxdate + 1) & "-" & Day(maxdate + 1) & "-" & Right(Year(maxdate + 1), 2)
'prompt the user to ask if this is correct...
newsheetname = InputBox("Is this the correct next date?" & Chr(13) & Chr(13) & _
"If so then click OK, otherwise change it first.", "Add New Date", newsheetname)
If newsheetname = "" Then Exit Sub
'append new number to date
newsheetname = newsheetname & " (" & (maxnumber + 1) & ")"
'check that sheet name does not already exist...
For sn = 1 To Sheets.Count
If Sheets(sn).Name = newsheetname Then GoTo sheet_exists
Next
'create new sheet and name it
Sheets("template").Copy After:=Sheets(Sheets.Count)
Sheets("template (2)").Name = newsheetname
Sheets(newsheetname).Visible = True
'insert new date and number to sheet
Range("ba1").Value = Month(maxdate + 1) & "/" & Day(maxdate + 1) & "/" & Right(Year(maxdate + 1), 2)
Range("az5").Value = maxnumber + 1
'copy contract number and title & location from previous sheet
Range("b8:aw8").Value = Sheets(previousname).Range("b8:aw8").Value
Range("b18:at31").Value = Sheets(previousname).Range("b18:at31").Value
Range("b185:aq243").Value = Sheets(previousname).Range("b185:aq243").Value
'run subroutine to carry cumulative totals through sheets
carry_totals_through
Exit Sub
'ERROR MESSAGES...
no_existing_sheet:
MsgBox "This operation could not be completed as there are no " & Chr(13) & _
"existing sheets of valid name from which to follow." _
, vbCritical + vbOKOnly, "Failed!"
Exit Sub
no_template:
MsgBox "This operation could not be completed as there is no " & Chr(13) & _
"template included in this workbook." _
, vbCritical + vbOKOnly, "Failed!"
Exit Sub
sheet_exists:
MsgBox "This operation could not be completed as there is " & Chr(13) & _
"already a sheet of this date in this workbook." _
, vbCritical + vbOKOnly, "Failed!"
End Sub
Sub carry_totals_through()
maxnumber = 0
minnumber = 999999
For sheetno = 1 To Sheets.Count
strg = Sheets(sheetno).Name
openbracketpos = InStr(1, strg, "(")
If openbracketpos > 8 And Right(strg, 1) = ")" And UCase(Left(strg, 3)) <> "TEM" Then
numberstrg = Right(strg, Len(strg) - openbracketpos)
numberstrg = Left(numberstrg, Len(numberstrg) - 1)
If Abs(numberstrg) > maxnumber Then maxnumber = Abs(numberstrg)
If Abs(numberstrg) < minnumber Then minnumber = Abs(numberstrg)
End If
Next
If maxnumber = 0 Or minnumber = 999999 Or maxnumber = minnumber Then Exit Sub
For sheetpos = minnumber To maxnumber
numberstrg = "(" & sheetpos & ")"
For sheetno = 1 To Sheets.Count
strg = Sheets(sheetno).Name
If Right(strg, Len(numberstrg)) = numberstrg Then
If sheetpos > minnumber Then
Sheets(sheetno).Range("BB37").Value = carrytotal
End If
carrytotal = Sheets(sheetno).Range("BB41").Value
End If
Next
Next
End Sub