0

is there a "tidier" way to do this? My macro continues with 10 mehr blocks like these.

And is it possible, to delete more than one cell? If i delete more then one cell it doesn't replace the empty ones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("P9:P381")) Is Nothing Then
    If IsEmpty(Target) = True Then
        Range("P8").Select
        Selection.Copy
        Range("P" & Target.Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End If
End If
If Not Intersect(Target, Range("R9:R381")) Is Nothing Then
    If IsEmpty(Target) = True Then
        Range("R8").Select
        Selection.Copy
        Range("R" & Target.Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End If
End If

I'm a beginner in vba, i'm sure you will notice this.

Thank you in advance.

J.schmidt
  • 721
  • 5
  • 27
  • You should first read and apply [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). • And I don't understand what you mean to say by *"If i delete more then one cell it doesn't replace the empty ones."* – Pᴇʜ Jan 17 '19 at 09:31

2 Answers2

0

You can replace

Range("P8").Select
Selection.Copy
Range("P" & Target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False

with

Range("p8").Copy Range("P" & Target.Row)

To delete a block of cells you need to specify in which direction you want to cells to "slide" in from. So

Range("D3:F4").Delete xlShiftToLeft

will bring cells from the right into the gap, while

Range("D3:F4").Delete xlShiftUp

will move cells up.

Edit to add: If you are changing cells within a cell change event you risk an endless loop, where your change triggers another loop through your code. To prevent this you need to turn off events at the start of your code and turn it back on at the end So:

    Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = false

and then at the end

   Application.EnableEvents = true
   End Sub
Harassed Dad
  • 4,669
  • 1
  • 10
  • 12
  • Thanks for the hint regarding Range and select. I appreciate this. Cann i specify multiple Target-Ranges in one if-block? Like putting P9:P381 and R9:R381 in one if-block The Purpose of this macro is to replace the content in a given range with a given cell, when it gets deleted. But it fires only, if i delete cell by cell. If i mark more then one cell in the gven range, it wont replace. – Jonathan Doe Jan 17 '19 at 09:50
  • To clarify: if i select P17 end press del, it replaces P17 with P8 if i select P17:P19 and press del, it doesn't do anything. – Jonathan Doe Jan 17 '19 at 10:09
0

You must loop through all cells c in Target and check each of them if it is empty.

Dim c As Range
If Not Intersect(Target, Range("P9:P381")) Is Nothing Then
    For Each c In Intersect(Target, Range("P9:P381"))
        If IsEmpty(c) = True Then
            Application.EnableEvents = False
            c.Value = Range("P8").Value
            Application.EnableEvents = True
        End If
    Next c
End If

Same for the other range.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • Running out of stack space – Jonathan Doe Jan 17 '19 at 11:00
  • @JonathanDoe Oh I forgot `Application.EnableEvents = False`. Please see my edit and try again. – Pᴇʜ Jan 17 '19 at 11:11
  • Doesn't work. I think i will keep my first makro with the improvements regarding Range and Selection – Jonathan Doe Jan 17 '19 at 11:45
  • @JonathanDoe Actually it does work, I tested the code. But I cannot help you if you just tell me *"Doesn't work"* because this is a useless error description. – Pᴇʜ Jan 17 '19 at 12:05
  • Okay, fine. in P8 is no value but a formula. I want to copy the formula back to the deleted cells. But if i replace your **c.Value = Range("P8").Value** with **Range("P8").Copy c** it doesn't work. If in P8 is a simple value, your solution works fine – Jonathan Doe Jan 17 '19 at 12:35
  • Now that's something we can start working with. Try `c.Formula = Range("P8").Formula` • What does *"with `Range("P8").Copy c` it doesn't work"* mean? Is the formula wrong or did you get an error? Which is the formula in P8? – Pᴇʜ Jan 17 '19 at 12:41
  • 1
    I have no idea, why it doesn't worked, but now it does. crazy. the line **c.Formula = Range("P8").Formula** worked, but copied the formula without adjusting the references (as expected). Im glad that you could help me. Thanks a lot – Jonathan Doe Jan 17 '19 at 14:48