PDA

View Full Version : Solved: Message Box in Macros with variables



klutz
07-28-2009, 09:16 AM
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?


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

Benzadeus
07-28-2009, 09:33 AM
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

klutz
07-28-2009, 11:39 AM
Gracias, Benzadeus (http://www.vbaexpress.com/forum/member.php?u=19707)

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...

Benzadeus
07-28-2009, 11:46 AM
What about...

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

klutz
07-28-2009, 11:51 AM
Yes sir, i was playing with it and placed it there it it works fine, although I changed a line.

MsgBox targetRow + r & " rows were inserted!", vbOKOnly

Thank you pal.

Klutz...