cell shift

[khalil]

hi all
i have sheet 1 and sheet 2 in excel workbook,
when i shift any cell from any row to the right in sheet1 , i want cell E from the same row in sheet 2 to be shifted as well.

thanks
khalil

 

[ZVI]

Hi Khalil,

Thanks for your PM. Not sure that I understand your task well.
Simple solution can be in inserting cells into both sheets by the aid of custom button in Sheet1 which is linked to this code:

' Synchronous inserting of cell(s) to activesheet and to Sheet2
Sub SynchroInsert()
  With Selection
    Sheets("Sheet2").Range(.Address).Insert Shift:=xlToRight
    .Insert Shift:=xlToRight
  End With
End Sub

Regards,

 

[khalil]

Hello,Vladimir
yes please we can go this way as you mentioned below

But in any cases, without your answering I can post in your thread full code for your current and the previous (freezing formats) tasks according to my current guessing about the required behaviors.
Just let me know if you wish to go this way.

thanks for your help
khalil

 

[ZVI]

Hi Khalil,

Thanks for posting in thread instead of in PMs.

There were two tasks in your PMs.
The first task was freezing/unfreezing formats of Sheet1 and Sheet2 at inserting cells with shifting.
It was realized via PM, my working example was uploaded here: To_Khalil_01.xls
Seems it works as expected.

The second task is this thread’s task.
At cells inserting into Sheet1 with right shifting it is required to insert the same amount of cells to Sheet2 starting from its E-column.
For 2nd task I suggest realization with custom functionality of right click menu button "Insert Cells". Clicking that Button in Sheet1 triggers the code "MyButton_Click", message asks for inserting cells in both sheets simultaneously. Choosing "Yes" inserts cells into two sheets without any other dialogs.
If "No" is chosen then standard dialog for one sheet inserting cells appears.
The described algorithm is based on my guessing. Therefore please post your description if it should be different.

Below is the code for both tasks, I put all code to ThisWorkbook module.
You can go to the code by pressing "VBA code" button in Sheet1.
There are also two buttons in Sheet1 and Sheet2: "Freeze formats" for saving & freezing formats, and "Edit formats" for editing formats allowing.
This is the link to example with full code: To_Khalil_02.zip

The full code

' All code should go to ThisWorkbook module
' There are two tasks realized by code:
' 1. Custom functionality of "Right Click" - "Insert Cells" button
'    i.e. inserting cells to Sheet1 and to E-column of Sheet2
' 2. Freezing/Unfreezing of the sheet formats

Option Explicit
Private WithEvents MyButton As Office.CommandBarButton

' This code runs automatically at loading of workbook. For debug run it by hand firstly
Private Sub Workbook_Open()
  Set MyButton = Application.CommandBars("Cell").FindControl(ID:=3181)
End Sub

' Triggering code of Right Click - "Insert Cells" button
Private Sub MyButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  
  '-->  User settings, change to suit
  Const TITLE = "Inserting to Sheet1 and to E-column of Sheet2"
  Const Sh1 = "Sheet1"  ' the name of sheet for manual inserting of cells with shifting
  Const Sh2 = "Sheet2"  ' the name of sheet for auto inserting of cells in E-column with shifting
  ' <-- End of settings
  
  ' Main
  If Not ActiveSheet Is Me.Sheets(Sh1) Then Exit Sub
  With Selection
    If MsgBox("Insert " & .Count & " cells synchronously with right shifting?", vbYesNo, TITLE) = vbYes Then
      Sheets(Sh2).Range(.Address).Offset(, 5 - .Column).Insert Shift:=xlToRight
      .Insert Shift:=xlToRight
      CancelDefault = True
    End If
  End With
End Sub


' ==== Below are the code for freezing/unfreezing of sheet's formats ===

' Automatically restoring of sheet's formats from its previously saved state
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  SheetFormatsRestore Sh
End Sub

' Code for "Freeze Formats" buttons of sheets
' Saving of the active sheet's formats in the hidding sheet
Sub SheetFormatsSave()
  Dim Sh As Worksheet, HiddenShName As String, aee As Boolean
  Set Sh = ActiveSheet
  HiddenShName = ActiveSheet.Name & "_Hidden"
  With Application
    .ScreenUpdating = False
    aee = .EnableEvents
    If aee Then .EnableEvents = False
  End With
  On Error Resume Next
  With Sheets(HiddenShName): End With
  If Err Then
    With Worksheets.Add(After:=Sheets(Sheets.Count))
      .Name = HiddenShName
    End With
  End If
  On Error GoTo 0
  With Sheets(HiddenShName)
    .Visible = xlSheetVisible
    .UsedRange.ClearFormats
  End With
  With Sh.UsedRange
    .Copy
    Sheets(HiddenShName).Range(.Cells(1).Address).PasteSpecial xlPasteFormats, xlNone, False, False
  End With
  Sheets(HiddenShName).Visible = xlSheetVeryHidden
  Sh.Activate
  With Application
    .CutCopyMode = False
    If aee Then .EnableEvents = True
    .ScreenUpdating = True
  End With
  MsgBox "Formats are preserved now"
End Sub

' Restoring of the active sheet's formats from the hidding sheet
Private Sub SheetFormatsRestore(Sh As Worksheet)
  Dim HiddenShName As String, sel As Range, aee As Boolean
  Set sel = Selection
  HiddenShName = Sh.Name & "_Hidden"
  On Error Resume Next
  With Sheets(HiddenShName): End With
  If Err Then
    Err.Clear
    Exit Sub
  End If
  With Application
    .ScreenUpdating = False
    aee = .EnableEvents
    If aee Then .EnableEvents = False
  End With
  Sh.UsedRange.ClearFormats
  On Error GoTo 0
  With Sheets(HiddenShName).UsedRange
    .Copy
    Sh.Range(.Cells(1).Address).PasteSpecial xlPasteFormats, xlNone, False, False
    .Parent.Visible = xlSheetVeryHidden
  End With
  sel.Parent.Activate
  sel.Select
  With Application
    .CutCopyMode = False
    If aee Then .EnableEvents = True
    .ScreenUpdating = True
  End With
  'MsgBox "Formats are restored"
End Sub

' Code for "Edit Formats" buttons of sheets
' Allowing of formats editing
Sub SheetFormatsEdit()
  On Error Resume Next
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    With Sheets(ActiveSheet.Name & "_Hidden")
      .Visible = xlSheetVisible
      .Delete
    End With
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
  End With
  MsgBox "Formats editing is allowed now"
End Sub

Regards,

 

[khalil]

Thanks Vladimir,
Thanks for your reply,
the last code you sent last week worked better for me , i could manage with custom buttons connected to the code,
this morning i sent a thread related to that code, you can find it in the link below. i needed undo insert code to go with that code in the active sheet. (sheet2 named as "AFT")
http://www.mrexcel.com/forum/showthread.php?p=2867821&highlight=cell+shift#post2867821

thanks again for the help
khalil

 

[ZVI]

...the last code you sent last week worked better for me , i could manage with custom buttons connected to the code

The functionality seems to be the same, the buttons are linked to the code, but code now is in Thisworkbook module. You can copy/paste buttons to another sheet as earlier.
5 in .Offset(, 5 - .Column) means 5th column - E-column number.
Could you please post the difference in functionality you have found?

Undo functionality can be realised by the aid of Application.OnUndo method, you can find example in VBA help.

 

[ZVI]

...this morning i sent a thread related to that code, you can find it in the link below. i needed undo insert code to go with that code in the active sheet. (sheet2 named as "AFT")
http://www.mrexcel.com/forum/showthread.php?p=2867821

Khalil, I've posted undo code in the thread of that link

 

[khalil]

ok vkadimir

in the example you sent today
when i insert a cell in row 12 in sheet1 it will insert one cell in sheet2 from row 12 , and when i insert again another cell in sheet1 in row 12 , there is no action in sheet 2, it seems to be the insert happens once in sheet 2

thanks
khalil

 

[ZVI]

Khalil,
I've added "Insert cells" button linked to SynchroInsert subroutine as you wanted. One-step undo buffer is added too.
Example can be downloaded from this link: To_Khalil_03.zip
Its code in ThisWorkbook module:

' ZVI:2011-09-19 http://www.mrexcel.com/forum/showthread.php?t=578452
' All code should go to ThisWorkbook module
' There are two tasks realized by code:
' 1. "Insert Cells" button inserts cells to Sh1 sheet and to E-column of Sh2 sheet
' 2. "Freeze Formats"/"Edit Formats" buttons are for Freezing/Unfreezing of the sheet formats
' Additionally one-step undo buffer is added according to http://www.mrexcel.com/forum/showthread.php?t=579711
Option Explicit
Dim RngUndo(1 To 2) As Range

' Code for "Insert cells" button
Sub SynchroInsert()
  
  '-->  User settings, change to suit
  Const TITLE = "Inserting to Sheet1 and to E-column of Sheet2"
  Const Sh1 = "Sheet1"  ' Name or index of sheet for manual inserting of cells with right shifting
  Const Sh2 = "AFT"     ' Name or index of sheet for auto inserting
  Const Sh2Col = "F"    ' Starting column in Sh2 for auto inserting
  ' <-- End of settingss
  
  ' Exit if ActiveSheet is not Sh1 sheet
  If Not ActiveSheet Is Me.Sheets(Sh1) Then Exit Sub
  
  ' Insert cells with right shifting
  With Selection
    If MsgBox("Insert " & .Count & " cells synchronously with right shifting?", vbYesNo, TITLE) = vbYes Then
      Sheets(Sh2).Range(.Address).Offset(, Columns(Sh2Col).Column - .Column).Insert Shift:=xlToRight
      .Insert Shift:=xlToRight
    End If
  End With
  
  ' Save inserted ranges for undo
  With Selection
    Set RngUndo(1) = .Cells
    Set RngUndo(2) = Sheets(Sh2).Range(.Address).Offset(, Columns(Sh2Col).Column - .Column)
  End With
  
  ' Charge undo buffer
  Application.OnUndo "Undo synchro-ins.", Me.CodeName & ".InsertingUndo"

End Sub

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

' ==== The code for freezing/unfreezing of sheet's formats ===

' Automatically restoring of sheet's formats from its previously saved state
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  SheetFormatsRestore Sh
End Sub

' Code for "Freeze Formats" buttons of sheets
' Saving of the active sheet's formats in the hidding sheet
Sub SheetFormatsSave()
  Dim Sh As Worksheet, HiddenShName As String, aee As Boolean
  Set Sh = ActiveSheet
  HiddenShName = ActiveSheet.Name & "_Hidden"
  With Application
    .ScreenUpdating = False
    aee = .EnableEvents
    If aee Then .EnableEvents = False
  End With
  On Error Resume Next
  With Sheets(HiddenShName): End With
  If Err Then
    With Worksheets.Add(After:=Sheets(Sheets.Count))
      .Name = HiddenShName
    End With
  End If
  On Error GoTo 0
  With Sheets(HiddenShName)
    .Visible = xlSheetVisible
    .UsedRange.ClearFormats
  End With
  With Sh.UsedRange
    .Copy
    Sheets(HiddenShName).Range(.Cells(1).Address).PasteSpecial xlPasteFormats, xlNone, False, False
  End With
  Sheets(HiddenShName).Visible = xlSheetVeryHidden
  Sh.Activate
  With Application
    .CutCopyMode = False
    If aee Then .EnableEvents = True
    .ScreenUpdating = True
  End With
  MsgBox "Formats are preserved now"
End Sub

' Code for "Edit Formats" buttons of sheets
' Allowing of formats editing
Sub SheetFormatsEdit()
  On Error Resume Next
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    With Sheets(ActiveSheet.Name & "_Hidden")
      .Visible = xlSheetVisible
      .Delete
    End With
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
  End With
  MsgBox "Formats editing is allowed now"
End Sub

' Restoring of the active sheet's formats from the hidding sheet
Private Sub SheetFormatsRestore(Sh As Worksheet)
  Dim HiddenShName As String, sel As Range, aee As Boolean
  Set sel = Selection
  HiddenShName = Sh.Name & "_Hidden"
  On Error Resume Next
  With Sheets(HiddenShName): End With
  If Err Then
    Err.Clear
    Exit Sub
  End If
  With Application
    .ScreenUpdating = False
    aee = .EnableEvents
    If aee Then .EnableEvents = False
  End With
  Sh.UsedRange.ClearFormats
  On Error GoTo 0
  With Sheets(HiddenShName).UsedRange
    .Copy
    Sh.Range(.Cells(1).Address).PasteSpecial xlPasteFormats, xlNone, False, False
    .Parent.Visible = xlSheetVeryHidden
  End With
  sel.Parent.Activate
  sel.Select
  With Application
    .CutCopyMode = False
    If aee Then .EnableEvents = True
    .ScreenUpdating = True
  End With
  'MsgBox "Formats are restored"
End Sub

Let me know if it works as expected.
Regards,

 

[khalil]

Thanks Vladimir,
This is great, but the code below is working as great and it is working in my project the only thing, we need it to do as many undo steps

your help is highly appreciated

khalil is very happy

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

' 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

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