-
Solved: Message Box in Macros with variables
How can i place a message in this macro that informs of the user of how many ROWS are being inserted/added and or how many rows are being deleted?
[VBA]
Public Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim cell As Range
Dim endRow As Long
Dim startRow As Long
Dim requiredRows As Long
Dim exisistingRows As Long
Me.Unprotect Password:="PWD"
'Single cell only, please
If Target.Columns.Count > 1 Then Exit Sub
'//Check if Col 'F'
If Target.Column = 6 Then
If Target.Offset(0, -1) <> "" Then
requiredRows = Target
'Don't delete first FOUR rows to not lose important formulas
If requiredRows < 5 Then
requiredRows = 5
End If
startRow = Target.row
'count light blue cells to determine exisisting rows number
For r = startRow To startRow + 300
If Cells(r, "E").Interior.ColorIndex <> 20 Then
endRow = r - 1
Exit For
End If
Next r
exisistingRows = endRow - startRow + 1
Application.EnableEvents = False
If requiredRows > exisistingRows Then
'add rows
For r = exisistingRows To requiredRows - 1
Rows(startRow + r).Insert
Rows(startRow + r - 1).Copy Range("a" & startRow + r)
Range("H" & startRow + r & ":t" & startRow + r).ClearContents
Next r
ElseIf requiredRows < exisistingRows Then
'delete rows
Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete
End If
Application.EnableEvents = True
Me.Protect Password:="PWD"
End If
'//Else check if in Range, Column 'D'
ElseIf Not Intersect(Target, Range("d24:d290")) Is Nothing Then
For Each cell In Target
If cell.Value <> "" Then
MakeChange cell.Offset(, 3)
Else
cell.Interior.ColorIndex = 20
End If
Next cell
End If
End Sub
[/VBA]
-
[VBA]Public Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim cell As Range
Dim endRow As Long
Dim startRow As Long
Dim requiredRows As Long
Dim exisistingRows As Long
Me.Unprotect Password:="PWD"
'Single cell only, please
If Target.Columns.Count > 1 Then Exit Sub
'//Check if Col 'F'
If Target.Column = 6 Then
If Target.Offset(0, -1) <> "" Then
requiredRows = Target
'Don't delete first FOUR rows to not lose important formulas
If requiredRows < 5 Then
requiredRows = 5
End If
startRow = Target.Row
'count light blue cells to determine exisisting rows number
For r = startRow To startRow + 300
If Cells(r, "E").Interior.ColorIndex <> 20 Then
endRow = r - 1
Exit For
End If
Next r
exisistingRows = endRow - startRow + 1
Application.EnableEvents = False
If requiredRows > exisistingRows Then
'add rows
For r = exisistingRows To requiredRows - 1
Rows(startRow + r).Insert
MsgBox startRow + r + 1 & " rows were deleted!", vbOKOnly
Rows(startRow + r - 1).Copy Range("a" & startRow + r)
Range("H" & startRow + r & ":t" & startRow + r).ClearContents
Next r
ElseIf requiredRows < exisistingRows Then
'delete rows
Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete
MsgBox exisistingRows - requiredRows & " rows were deleted!", vbOKOnly
End If
Application.EnableEvents = True
Me.Protect Password:="PWD"
End If
'//Else check if in Range, Column 'D'
ElseIf Not Intersect(Target, Range("d24:d290")) Is Nothing Then
For Each cell In Target
If cell.Value <> "" Then
MakeChange cell.Offset(, 3)
Else
cell.Interior.ColorIndex = 20
End If
Next cell
End If
End Sub
[/VBA]
-
Gracias, Benzadeus
Have one query,
When adding addtional rows the message box appears for every insertion: example, be defualt I have 5 rows, if I want to add 3 addtional ones the message will pop up for each insertion ( on 6, 7 and 8).
Is there anyway to only appear as stating that " 3 additional rows have been inserted, instead of the message box popping up for each individual one?
For deletion there is no problem the message box alerts that there are eg, 3 rows that were deleted.
Thanx again...
-
What about...
[vba]Public Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim cell As Range
Dim endRow As Long
Dim startRow As Long
Dim requiredRows As Long
Dim exisistingRows As Long
Me.Unprotect Password:="PWD"
'Single cell only, please
If Target.Columns.Count > 1 Then Exit Sub
'//Check if Col 'F'
If Target.Column = 6 Then
If Target.Offset(0, -1) <> "" Then
requiredRows = Target
'Don't delete first FOUR rows to not lose important formulas
If requiredRows < 5 Then
requiredRows = 5
End If
startRow = Target.Row
'count light blue cells to determine exisisting rows number
For r = startRow To startRow + 300
If Cells(r, "E").Interior.ColorIndex <> 20 Then
endRow = r - 1
Exit For
End If
Next r
exisistingRows = endRow - startRow + 1
Application.EnableEvents = False
If requiredRows > exisistingRows Then
'add rows
For r = exisistingRows To requiredRows - 1
Rows(startRow + r).Insert
Rows(startRow + r - 1).Copy Range("a" & startRow + r)
Range("H" & startRow + r & ":t" & startRow + r).ClearContents
Next r
MsgBox startRow + r & " rows were inserted!", vbOKOnly
ElseIf requiredRows < exisistingRows Then
'delete rows
Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete
MsgBox exisistingRows - requiredRows & " rows were deleted!", vbOKOnly
End If
Application.EnableEvents = True
Me.Protect Password:="PWD"
End If
'//Else check if in Range, Column 'D'
ElseIf Not Intersect(Target, Range("d24:d290")) Is Nothing Then
For Each cell In Target
If cell.Value <> "" Then
MakeChange cell.Offset(, 3)
Else
cell.Interior.ColorIndex = 20
End If
Next cell
End If
End Sub[/vba]
-
OK, solved..
Yes sir, i was playing with it and placed it there it it works fine, although I changed a line.
[VBA]MsgBox targetRow + r & " rows were inserted!", vbOKOnly[/VBA]
Thank you pal.
Klutz...
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules