' This needs "init" sheet for control extra backups
' >> ThisWorkbook
Sub Do_BackUp()
Application.ScreenUpdating = False
B_num = Sheets("init").Range("A1")
If B_num = Empty Or B_num > 99 Then B_num = 0
B_num = B_num + 1
Sheets("init").Range("A1") = B_num
If B_num < 10 Then B_num = "0" & B_num
ThisWorkbook.Save
BackUp_Path = ActiveWorkbook.Path & Application.PathSeparator & "backup"
BackUp_File = BackUp_Path & Application.PathSeparator & B_num & "_" & ActiveWorkbook.Name
CAN_BACKUP = True
On Error Resume Next
IS_PATH = Dir(BackUp_Path, vbDirectory)
If Err.Number <> 0 And IS_PATH = "backup" Then
CAN_BACKUP = False
If MsgBox("Make the BackUpFolder?", vbYesNo, "BackUp") = vbYes Then
MkDir BackUp_Path
On Error Resume Next
IS_PATH = Dir(BackUp_Path, vbDirectory)
If Err.Number <> 0 And IS_PATH = "backup" Then
MsgBox ("Couldn't make backup-folder!" & Chr(13) & Chr(13) & BackUp_Path)
Else
CAN_BACKUP = True
End If
End If
End If
If CAN_BACKUP Then ActiveWorkbook.SaveCopyAs (BackUp_File)
Application.Wait (Now + TimeSerial(0, 0, 1))
End Sub
Sub Do_Extra_BackUp()
Sheets("init").Range("A6") = Sheets("init").Range("A6") + 1
If Sheets("init").Range("A6") > 10 Then
Application.ScreenUpdating = True
' indication ON
' org_color = Sheets("prod").Range("B6").Interior.Color
' Sheets("prod").Range("B6").Interior.ColorIndex = 6
Do_BackUp
Sheets("init").Range("A6") = Empty
' indication OFF
' Sheets("prod").Range("B6").Interior.Color = org_color
Application.ScreenUpdating = True
End If
End Sub
' >> Sheets
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
' Your Code here
ThisWorkbook.Do_Extra_BackUp
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub