Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Dim oldVal As Double, newVal As Double
Set targ = Range("B3") 'Watch these cells
Set cel = Intersect(Target, targ)
If cel Is Nothing Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = cel.Value
Application.Undo
oldVal = cel.Value
If oldVal <> newVal Then
'Shift just cell B3 down
cel.Insert Shift:=xlShiftDown
cel.Offset(-1, 0).Value = newVal
'Shift entire row down
'cel.EntireRow.Insert Shift:=xlShiftDown, CopyOrigin:=cel.EntireRow
'cel.Offset(-1, 0).EntireRow.Value = cel.EntireRow.Value
'cel.Offset(-1, 0).Value = newVal
End If
Application.EnableEvents = True
End Sub
EE-BID-ASKQ27302334.xlsm
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Dim oldVal As Double, newVal As Double
Set targ = Range("B3") 'Watch these cells
Set cel = Intersect(Target, targ)
If cel Is Nothing Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = cel.Value
Application.Undo
oldVal = cel.Value
If oldVal <> newVal Then
'Shift entire row down
cel.EntireRow.Insert Shift:=xlShiftDown, CopyOrigin:=cel.EntireRow
cel.EntireRow.Copy cel.Offset(-1, 0).EntireRow
cel.Offset(-1, 0).Value = newVal
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Dim oldVal As Double, newVal As Double
Set cel = Range("B3")
Set targ = Range("B25") 'Watch these cells
Set targ = Intersect(Target, targ)
If targ Is Nothing Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = targ.Value
Application.Undo
oldVal = targ.Value
If oldVal <> newVal Then
'Shift entire row down
cel.Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown, CopyOrigin:=cel.EntireRow
cel.EntireRow.Copy cel.Offset(1, 0).EntireRow
cel.EntireRow.Offset(1, 0).Formula = cel.EntireRow.Value
cel.Value = newVal
targ.Value = newVal
Rows(24).Delete
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Calculate()
Dim cel As Range, targ As Range
Static oldVal As Double
Dim newVal As Double
Set cel = Range("B3")
Set targ = Range("B25")
Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = targ.Value
If oldVal <> newVal Then
'Shift entire row down
cel.EntireRow.Insert Shift:=xlShiftDown
cel.EntireRow.Copy cel.Offset(-1, 0).EntireRow
cel.EntireRow.Offset(-1, 0).Formula = targ.EntireRow.Value
oldVal = newVal
Rows(24).Delete
End If
Application.EnableEvents = True
End Sub
EE-BID-ASKQ27302334UpdateALT.xlsm
Private Sub Worksheet_Calculate()
Dim cel As Range, targ As Range
Static oldVal(14) As Double
Dim i As Long, j As Long
Dim newVal As Double
Set cel = Range("B3")
Set targ = Range("B25")
Application.EnableEvents = False
Application.ScreenUpdating = False
newVal = targ.Value
For j = 2 To 14 'Watch columns B through N on row 25 for changes
If oldVal(j) <> targ.Cells(1, j - 1) Then
'Shift entire row down
cel.EntireRow.Insert Shift:=xlShiftDown
cel.EntireRow.Copy cel.Offset(-1, 0).EntireRow
cel.EntireRow.Offset(-1, 0).Formula = targ.EntireRow.Value
For i = 2 To 14
oldVal(i) = targ.Cells(1, i - 1).Value
Next
Rows(24).Delete
Exit For
End If
Next
Application.EnableEvents = True
End Sub
EE-BID-ASKQ27302334UpdateALT.xlsm
Private Sub Worksheet_Calculate()
Dim rg As Range, rg2 As Range, targ As Range
Static oldVal(13) As Double
Dim i As Long, j As Long, nCols As Long
Set targ = Range("Q3:AC3") 'Watch these cells for changes
nCols = targ.Columns.Count
Set rg = Range("B3:N3") 'Put changed values here, pushing old values down
Set rg2 = rg.Offset(0, -1).Resize(1, nCols + 2)
Application.EnableEvents = False
Application.ScreenUpdating = False
For j = 1 To nCols 'Watch columns Q through AC on row 3 for changes
If oldVal(j) <> targ.Cells(1, j) Then
'Shift data down
rg2.Insert Shift:=xlShiftDown
rg2.Copy rg2.Offset(-1, 0)
rg.Offset(-1, 0).Formula = targ.Value
For i = 1 To nCols 'Capture values of data for next run
oldVal(i) = targ.Cells(1, i).Value
Next
Exit For
End If
Next
Application.EnableEvents = True
End Sub
Sub Restore()
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Calculate()
Dim rg As Range, rg2 As Range, targ As Range
Static oldVal(13) As Double
Dim i As Long, j As Long, nCols As Long
Set targ = Range("Q3:V3") 'Watch these cells for changes
nCols = targ.Columns.Count
Set rg = Range("B3:N3") 'Put changed values here, pushing old values down
Set rg2 = rg.Offset(0, -1).Resize(1, rg.Columns.Count + 2)
Application.EnableEvents = False
Application.ScreenUpdating = False
For j = 1 To nCols 'Watch columns Q through AC on row 3 for changes
If oldVal(j) <> targ.Cells(1, j) Then
'Shift data down
rg2.Insert Shift:=xlShiftDown
rg2.Copy rg2.Offset(-1, 0)
'rg.Offset(-1, 0).Resize(1, nCols).Formula = targ.Value 'Copy over just data in Q3:V3
rg.Offset(-1, 0).Formula = targ.Resize(1, rg.Columns.Count).Value 'Copy over data in Q3:AC3
For i = 1 To nCols 'Capture values of data for next run
oldVal(i) = targ.Cells(1, i).Value
Next
Exit For
End If
Next
Application.EnableEvents = True
End Sub
EE-BID-ASKV3Q27302334.xlsm
Private Sub Worksheet_Calculate()
Dim rg As Range, rg2 As Range, targ As Range
Static oldVal(13) As Double
Dim i As Long, j As Long, nCols As Long
Set targ = Range("Q3:V3") 'Watch these cells for changes
nCols = targ.Columns.Count
Set rg = Range("B3:G3") 'Put changed values here, pushing old values down
Set rg2 = rg 'Push formatting and formulas down in range rg2
Application.EnableEvents = False
Application.ScreenUpdating = False
For j = 1 To nCols 'Watch columns Q through AC on row 3 for changes
If oldVal(j) <> targ.Cells(1, j) Then
'Shift data down
rg2.Insert Shift:=xlShiftDown
rg2.Copy
rg2.Offset(-1, 0).PasteSpecial xlPasteValues
rg2.Copy
rg2.Offset(-1, 0).PasteSpecial xlPasteFormats
'rg.Offset(-1, 0).Resize(1, nCols).Formula = targ.Value 'Copy data from same number of columns as targ
rg.Offset(-1, 0).Formula = targ.Resize(1, rg.Columns.Count).Value 'Copy data into same number of columns as rg
For i = 1 To nCols 'Capture values of data for next run
oldVal(i) = targ.Cells(1, i).Value
Next
Exit For
End If
Next
Application.EnableEvents = True
End Sub
EE-The-Tapev10Q27302334.xlsm
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
conditional formatting | 4 | 42 | |
Excel conditional formatting based on 'zero value' | 6 | 20 | |
Merging spreadsheets | 8 | 37 | |
EXCEL formual to calculate Quarter | 6 | 36 |
Join the community of 500,000 technology professionals and ask your questions.