cell shift

[khalil]

hello all,
i need help

I have this code and it is working great in inserting and shifting cells,

i need another code to go with this code To undo insert. using custom button in the active sheet.
__________________________________________________________

' Synchronous inserting of cell(s) to the activesheet and to AFT
Sub SynchroInsert()
With Selection
Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count).Insert Shift:=xlToRight
.Insert Shift:=xlToRight
End With
End Sub

___________________________________________________________

thanks
Khalil

 

[ZVI]

Hi Khalil,
Here is the solution for one-step undo:

' Code of Module1
Dim RngUndo(1 To 2) As Range

Sub SynchroInsert()
  ' Insert with shifting
  With Selection
    Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count).Insert Shift:=xlToRight
    .Insert Shift:=xlToRight
  End With
  ' Save inserted ranges for undo
  With Selection
    Set RngUndo(1) = .Cells
    Set RngUndo(2) = Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count)
  End With
  ' Charge undo buffer
  Application.OnUndo "Undo synchro-ins.", "InsertingUndo"
End Sub

' Undo subruotine
Sub InsertingUndo()
  On Error Resume Next
  RngUndo(1).Delete Shift:=xlShiftToLeft
  RngUndo(2).Delete Shift:=xlShiftToLeft
End Sub

Regards,

 

[khalil]

thank you very much Vladimir
khalil

 

[khalil]

Re: undo insert

good morning

this code works great in my project with one-step undo insert , but it needs little modification to do several undo inserts ,
................................................

' Code of Module1
Dim RngUndo(1 To 2) As Range

Sub SynchroInsert()
' Insert with shifting
With Selection
Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count).Insert Shift:=xlToRight
.Insert Shift:=xlToRight
End With
' Save inserted ranges for undo
With Selection
Set RngUndo(1) = .Cells
Set RngUndo(2) = Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count)
End With
' Charge undo buffer
Application.OnUndo "Undo synchro-ins.", "InsertingUndo"
End Sub

' Undo subruotine
Sub InsertingUndo()
On Error Resume Next
RngUndo(1).Delete Shift:=xlShiftToLeft
RngUndo(2).Delete Shift:=xlShiftToLeft
End Sub

................................................................................................

i hope this time i posted in the right thread, also i changed the title name

thanks allot , khalil

 

[ZVI]

There is no internal VBA method for more than one step undo.
But for your case below is requested "little modification" for 10 undo steps with two buttons "Synchro inserting" and "Undo of synchro inserting":

' Code of Module1
Const UndoSteps = 10      ' <-- undo buffer max steps for syncro inserted ranges
Dim UndoCol As New Collection

' Code of "Synchro inserting" button
Sub SynchroInsertButton()
  Dim Rng(1 To 2) As Range
  ' Insert with shifting
  With Selection
    Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count).Insert Shift:=xlToRight
    .Insert Shift:=xlToRight
  End With
  ' Save references of inserted ranges in Rng()
  With Selection
    Set Rng(1) = .Cells
    Set Rng(2) = Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count)
  End With
  ' Save Rng in collection
  UndoCol.Add Rng
  ' Delete an extra steps of undo buffer
  If UndoCol.Count > UndoSteps Then
    UndoCol.Remove 1
  End If
End Sub

' Code of "Undo of synchro inserting" button
Sub UndoButton()
  Dim a
  If UndoCol.Count = 0 Then
    MsgBox "Undo buffer of synchro inserted cells is empty"
    Exit Sub
  End If
  On Error Resume Next
  a = UndoCol.Item(UndoCol.Count)
  a(1).Parent.Select
  a(1).Select
  a(1).Delete Shift:=xlShiftToLeft
  a(2).Delete Shift:=xlShiftToLeft
  UndoCol.Remove UndoCol.Count
End Sub

 

[khalil]

good morning Vladimir

this works great , and ends my project.
thank you very much

KHalil

 

[ZVI]

I'm glad it helped, KHalil
Kind regards,