0

I am new to VBA and try to handle a Sheet with 2 tables and specific macros. I created macros within one single module and placed to buttons called: Positionen_Einfügen (insert entire rows) and Zeile_Löschen (delete entire row).

The code runs perfect, but now I want to dilimit these macros for a specific area in my Wokrsheet(Einzelkosten), but the area is still flexible since you are allowed to insert multiple rows or delete one row.

In this case I placed an big red "Y" where the table stops. My "Y" is flexible and moves of course with the macros if you use them. Like several rows down or one up.

I want to use this "Y" as a boarder for the ActiveCell.EntireRow.Select. So can I write a .Find("Y") function within my macros, like in the code below:

Position_Einfügen()
'Disable Excel feautres to prevent Errors
ActiveSheet.Unprotect

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False

'set specific range for area
Dim Target As Range
Set Target = Range("A9:R200").Find(Y, LookIn:=xlValues)


icountROws = Application.InputBox(Prompt:="How many rows do you want to  insert after Line " _
& ActiveCell.Row & " ?", Type:=1)
' Dont allow negative numbers or empty field: Error Handling
If icountROws <= 0 Then End

ActiveCell.EntireRow.Select
'Can this work?
     If ActiveCell.EntireRow.Select >= Y And ActiveCell.EntireRow.Select = Y Then
     MsgBox ("Sie befinden sich außerhalb des erlaubten Bereichs")
     End If
 Exit Sub
     Else If
     Selection.Copy
     ' Selection.PasteSpecial xlPasteFormulas
     Rows(ActiveCell.Row & ":" & ActiveCell.Row + icountROws - 1).Insert shift:=xlDown
     End If

    'Re-enable features after running macro, auto-debugging
     Application.Calculation = xlCalculationAutomatic
     Application.EnableEvents = True
     Application.ScreenUpdating = True

     ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFormattingCells:=True, AllowFormattingColumns:=True
     ActiveSheet.EnableSelection = xlNoRestrictions
End Sub

Here is the 2. macro: Delete Function

Sub Zeile_Löschen()

'select row to delete
Dim DeletePrompt As Integer

DeletePrompt = MsgBox("Are you sure you want to delete this row?", vbYesNo +   vbQuestion, "Delete")
    ActiveSheet.Unprotect
    If DeletePrompt = vbYes Then
    Rows(ActiveCell.Row).Delete
    Else
        'do nothing
    End If

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFormattingCells:=True, AllowFormattingColumns:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
End Sub

Within my black highlighted brackets is the specific area where the code is allowed to run, otherwise Prompt MsgBox("You are outside of the table")

braX
  • 11,506
  • 5
  • 20
  • 33

1 Answers1

0

You can operate with Target.Row and Activecell.Row, like this:

Set Target = Range("A9:R200").Find("Y", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True) 
   ' note the quotes around Y
If Target Is Nothing Then
    iMaxRow = 200             ' need to set some maximum value even if Y is not found
Else
    iMaxRow = Target.Row
Endif
If Activecell.Row >iMaxRow Then
     Msgbox "out of range"
     End
End
... and here you can continue inserting

Similarly, you can control the horizontal dimension with Target.Column. And it can make sense to limit the number of inserted rows, too, like this:

If ActiveCell.Row + icountROws > iMaxRow Then icountRows = iMAxRow - ActiveCell.Row 

Try to avoid using select. See more here: How To Avoid Using Select. Anyhow, you can not compare an entire (selected) row with a value.

Instead of

ActiveCell.EntireRow.Select 'Can this work?
If ActiveCell.EntireRow.Select >= Y And ActiveCell.EntireRow.Select = Y Then

use

If Target.Value = "Y" Then 

or

If Target.Value = "Y" Or Target.Value = "y" Then 

Instead of

ActiveCell.EntireRow.Select
Selection.Copy

use

ActiveCell.EntireRow.Copy
AcsErno
  • 1,597
  • 1
  • 7
  • 10
  • I am very grateful for your fast response and solutions. It works perfect! – Martin Straußberger Oct 18 '18 at 13:39
  • One further point. How can I copy an entire row with all formulas but also emptying the Text in the same time? Thanks in advance :-) – Martin Straußberger Oct 18 '18 at 13:46
  • If you only want to copy formulas and no content, use this: `ActiveCell.EntireRow.Copy` and then `range("a22").PasteSpecial xlPasteFormulas`, where "a22" represents the target row. Please note that target column always must be "A" when copying entire row. BTW, as you work with a range of rectangular shape, why don't you take a look at how to work with ranges instead of entire rows. – AcsErno Oct 19 '18 at 08:19