Copy Formula from Cell 200 of that column into deleted Cell - VB

[eli_m]

Hi - This site has helped me so much I thought I'd sign up and ask my own question and hopefully help others

My question:
What would be the VB code for when I delete data from a cell it then automatically copies the formula that's in cell 200 of that row into the newly deleted cell?

eg.

1. Delete data in cell A1
2. Formula from A200 gets put into cell A1

I also want it to work for all my columns which is A to AR.

Another example:

1. Delete data from F68
2. Formula from F200 populates into F68

Any help would be greatly appreciated!

Thank you in advance

 

[Peter_SSs]

Welcome to the MrExcel board!

automatically copies the formula that's in cell 200 of that row

I think that you mean cell 200 of that column?

You could try this Worksheet_Change event code.
To implement ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Test (with a copy of your workbook).

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, c As Range
 
  Set Changed = Intersect(Target, Columns("A:AR"))
  If Not Changed Is Nothing Then
    Application.EnableEvents = False
    For Each c In Changed
      If IsEmpty(c.Value) Then Cells(200, c.Column).Copy Destination:=c
    Next c
    Application.EnableEvents = True
  End If
End Sub

 

[eli_m]

Welcome to the MrExcel board!


I think that you mean cell 200 of that column?

You could try this Worksheet_Change event code.
To implement ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Test (with a copy of your workbook).

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, c As Range
 
  Set Changed = Intersect(Target, Columns("A:AR"))
  If Not Changed Is Nothing Then
    Application.EnableEvents = False
    For Each c In Changed
      If IsEmpty(c.Value) Then Cells(200, c.Column).Copy Destination:=c
    Next c
    Application.EnableEvents = True
  End If
End Sub

Wow! Thank you so much! That worked a treat. My workbook is running slow due to the amount of code. Do you see any thing I could do to make it run a bit better:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
Application.Calculate
End If
End Sub

' Ignore Errors when Worksheet Activated
Private Sub Worksheet_Activate()

Dim r As Range: Set r = Range("A2:AR200")
Dim cel As Range

'Data Validation Error
For Each cel In r
    cel.Errors(8).Ignore = True
Next cel

'Inconsistent Error
For Each cel In r
    cel.Errors(9).Ignore = True
Next cel

'Lock Error
For Each cel In r
    cel.Errors(6).Ignore = True
Next cel

End Sub

' Ignore Errors with Worksheet Clicks
Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range: Set r = Range("A2:AR200")
Dim cel As Range

'Data Validation Error
For Each cel In r
    cel.Errors(8).Ignore = True
Next cel

'Inconsistent Error
For Each cel In r
    cel.Errors(9).Ignore = True
Next cel

'Lock Error
For Each cel In r
    cel.Errors(6).Ignore = True
Next cel

' Copy from Line 200 into deleted cells
  Dim Changed As Range, c As Range
 
  Set Changed = Intersect(Target, Columns("A:AR"))
  If Not Changed Is Nothing Then
    Application.EnableEvents = False
    For Each c In Changed
      If IsEmpty(c.Value) Then Cells(200, c.Column).Copy Destination:=c
    Next c
    Application.EnableEvents = True
  End If

End Sub

' Sort by Surgery Date with Worksheet Activation after Deactivation
Private Sub Worksheet_Deactivate()
  ThisWorkbook.RefreshAll

On Error Resume Next

If Not Intersect(Target, ThisWorkbook.Sheets("IPS Cases").Range("B:B")) Is Nothing Then
ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

End If

End Sub

 

[Peter_SSs]

Wow! Thank you so much! That worked a treat.

Good news! Thanks for the confirmation.

My workbook is running slow due to the amount of code. Do you see any thing I could do to make it run a bit better:

Without studying the code in too much detail and without knowing what you are really trying to achieve ..

In the Worksheet_Change code, which I presume is going to fire fairly regularly you are checking over 26,000 cells (44 columns by 200 rows by 3 times) individually for error notifications. That is going to take some time.

Have you considered
- Turning off the error checking notifications in File - Options - Formulas, or
- Only checking the changed cell - if that would be relevant etc?

As a test, what about commenting out this code for a while and see if that does change the 'speed' of your sheet?

'Data Validation Error
For Each cel In r
    cel.Errors(8).Ignore = True
Next cel

'Inconsistent Error
For Each cel In r
    cel.Errors(9).Ignore = True
Next cel

'Lock Error
For Each cel In r
    cel.Errors(6).Ignore = True
Next cel

If you do really need every cell set every time then this might be a bit faster but haven't tested to time any difference

For Each cel In r
  With cel
    .Errors(8).Ignore = True
    .Errors(9).Ignore = True
    .Errors(6).Ignore = True
  End With
Next cel

 

[eli_m]

Good news! Thanks for the confirmation.


Without studying the code in too much detail and without knowing what you are really trying to achieve ..

In the Worksheet_Change code, which I presume is going to fire fairly regularly you are checking over 26,000 cells (44 columns by 200 rows by 3 times) individually for error notifications. That is going to take some time.

Have you considered
- Turning off the error checking notifications in File - Options - Formulas, or
- Only checking the changed cell - if that would be relevant etc?

As a test, what about commenting out this code for a while and see if that does change the 'speed' of your sheet?

'Data Validation Error
For Each cel In r
    cel.Errors(8).Ignore = True
Next cel

'Inconsistent Error
For Each cel In r
    cel.Errors(9).Ignore = True
Next cel

'Lock Error
For Each cel In r
    cel.Errors(6).Ignore = True
Next cel

If you do really need every cell set every time then this might be a bit faster but haven't tested to time any difference

For Each cel In r
  With cel
    .Errors(8).Ignore = True
    .Errors(9).Ignore = True
    .Errors(6).Ignore = True
  End With
Next cel

I did consider turning off the error checking notifications but it's a shared file with other people and I don't want them to see the errors either. does File - Options - Formulas turn it off for them as well or just me?

This worked so I am happy to use this instead:

For Each cel In r
  With cel
    .Errors(8).Ignore = True
    .Errors(9).Ignore = True
    .Errors(6).Ignore = True
  End With
Next cel

Thanks again for your help

 

[Peter_SSs]

does File - Options - Formulas turn it off for them as well or just me?

The setting is just for you.

Thanks again for your help

 

[eli_m]

The setting is just for you.

I just realised I am getting an error:

[/CODE]
' Ignore Errors when Workbook is Opened
Private Sub Workbook_Open()

Dim r As Range: Set r = Range("A2:AR200")
Dim cel As Range

For Each cel In r
With cel
.Errors(8).Ignore = True 'Data Validation Error
.Errors(9).Ignore = True 'Inconsistent Error
.Errors(6).Ignore = True 'Lock Error
End With
Next cel
End Sub

' Sort by Surgery Date with Worksheet Activation after Deactivation

Private Sub Workbook_Open()

End Sub

ThisWorkbook.RefreshAll

On Error Resume Next

If Not Intersect(Target, ThisWorkbook.Sheets("IPS Cases").Range("B:B")) Is Nothing Then
ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If


End Sub

 

[Peter_SSs]

I just realised I am getting an error:

What error?
What line of code?

Looks like you may have messed up posting your code. Perhaps you could try again and put it in code tags this time.

Issues that I have noticed ..

1. You have two Private Sub Workbook_Open() codes. The workbook can only have one.
2. You have the start of two procedures as mentioned above, but three End Sub lines.
3. The first procedure does not say which worksheet to ignore those errors on but it appears the workbook may have more than one worksheet(?)
4. The final procedure uses 'Target'. Target is not defined anywhere and is usually a vba self-generated range relating to a a change event code but the code posted does not relate to a range change event of any kind.

 

[eli_m]

What error?
What line of code?

Looks like you may have messed up posting your code. Perhaps you could try again and put it in code tags this time.

Issues that I have noticed ..

1. You have two Private Sub Workbook_Open() codes. The workbook can only have one.
2. You have the start of two procedures as mentioned above, but three End Sub lines.
3. The first procedure does not say which worksheet to ignore those errors on but it appears the workbook may have more than one worksheet(?)
4. The final procedure uses 'Target'. Target is not defined anywhere and is usually a vba self-generated range relating to a a change event code but the code posted does not relate to a range change event of any kind.

Ahh I see.

How would I merge both of these:

' Sort by Surgery Date with Worksheet Activation after Deactivation
Private Sub Worksheet_Deactivate()
  ThisWorkbook.RefreshAll

On Error Resume Next

If Not Intersect(Target, ThisWorkbook.Sheets("IPS Cases").Range("B:B")) Is Nothing Then
ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

End If

End Sub

and

' Ignore Errors when Workbook is Opened
Private Sub Workbook_Open()

Dim r As Range: Set r = Range("A2:AR200")
Dim cel As Range

'Data Validation Error
For Each cel In r
    cel.Errors(8).Ignore = True
Next cel

'Inconsistent Error
For Each cel In r
    cel.Errors(9).Ignore = True
Next cel

'Lock Error
For Each cel In r
    cel.Errors(6).Ignore = True
Next cel

End Sub

When I try this shows up as red:

ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _

Order1:=xlAscending, Header:=xlYes, _

OrderCustom:=1, MatchCase:=False, _

Orientation:=xlTopToBottom

Full code:

' Ignore Errors when Workbook is Opened
Private Sub Workbook_Open()

Dim r As Range: Set r = Range("A2:AR200")
Dim cel As Range

'Data Validation Error
For Each cel In r
    cel.Errors(8).Ignore = True
Next cel

'Inconsistent Error
For Each cel In r
    cel.Errors(9).Ignore = True
Next cel

'Lock Error
For Each cel In r
    cel.Errors(6).Ignore = True
Next cel

'Sort by Surgery Date with Worksheet Activation after Deactivation

ThisWorkbook.RefreshAll


On Error Resume Next



If Not Intersect(Target, ThisWorkbook.Sheets("IPS Cases").Range("B:B")) Is Nothing Then

ThisWorkbook.Sheets("IPS Cases").Range("B2").Sort Key1:=ThisWorkbook.Sheets("IPS Cases").Range("B3"), _

Order1:=xlAscending, Header:=xlYes, _

OrderCustom:=1, MatchCase:=False, _

Orientation:=xlTopToBottom



End If



End Sub



End Sub

 

[Peter_SSs]

Pure guess as I still don't know what worksheets are in your workbook, what sheet the 'ignore errors' code is supposed to act on if there is more than one worksheet in the workbook or what the On Error Resume Next is supposed to be protecting against.

As written, this code will do the ignore errors on whatever the active sheet is when the workbook is opened. If there are multiple sheets and the ignore errors needs to act on a particular sheet then that will need to be built into the code, most likely based on the name of that worksheet.

Private Sub Workbook_Open()
  Dim r As Range
  Dim cel As Range
  
  Set r = Range("A2:AR200")
  For Each cel In r
    With cel
      .Errors(8).Ignore = True 'Data Validation Error
      .Errors(9).Ignore = True 'Inconsistent Error
      .Errors(6).Ignore = True 'Lock Error
    End With
  Next cel

  ThisWorkbook.RefreshAll

  On Error Resume Next
  With Sheets("IPS Cases")
    Intersect(.Columns("B"), .UsedRange).Sort Key1:=.Range("B3"), Order1:=xlAscending, Header:=xlYes
  End With

End Sub