Solved: 2 codes with ambigous names, HELP

[klutz]

Hi,

i have 2 codes in the same worksheet that perfomr different functions but both start with the same ----> Public Sub Worksheet_Change(ByVal Target As Range).

I need both codes in the same worksheet, what do i need to change to get them working?:dunno

Thanks

[rbrhodes]

Hi k,

You'll have to combine them. If you don't know how then post code here.

Basically an 'IF' condition then either an 'ELSEIF' or another IF....

[klutz]

Hi k,

You'll have to combine them. If you don't know how then post code here.

Basically an 'IF' condition then either an 'ELSEIF' or another IF....

Here is one code

Public Sub Worksheet_Change(ByVal Target As Range)
Dim startRow As Long
Dim endRow As Long
Dim exisistingRows As Long, requiredRows As Long
Dim r As Long

If Target.Cells.Count = 1 _
And Target.Column = 6 Then
If Target.Offset(0, -1) <> "" Then
requiredRows = Target

'Don't delete first two rows to not loose important formulas
If requiredRows < 4 Then
requiredRows = 4
End If

startRow = Target.row
'count light blue cells to determine exisisting rows number
For r = startRow To startRow + 200
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("f" & 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
End If
End If

End Sub


Here is the other...


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Target.Columns.Count > 1 Then Exit Sub
If 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


Appreciate any help on this...

Thanx...

[rbrhodes]

Hi k,

So first they both check for a single cell. Done

Secondly they check for a range: 1) Col F, 2) Col D <range>

here ya go:



Option Explicit
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
'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 two rows to not lose important formulas
If requiredRows < 4 Then
requiredRows = 4
End If

startRow = Target.Row
'count light blue cells to determine exisisting rows number
For r = startRow To startRow + 200
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("f" & 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
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]

Thanks rbrhodes.

One thing though, the first part of the code is not inserting any additional rows. When i select column F27 and enter a number it does not insert any rows.

Any thoughts please?

Thanx..

[GTO]

Thanks rbrhodes.

One thing though, the first part of the code is not inserting any additional rows. When i select column F27 and enter a number it does not insert any rows.

Any thoughts please?

Thanx..

Greetings,

I tested dr's suggested in a blank wb (just for the first IF) and after ensuring there was a value in E27, entering a value in F27 was caught just fine.

Maybe a silly question, but are you sure you put the code in the correct worksheet's module?

If still not working, consider posting an example wb, or at minimum, all the code you have in the effected worksheet's module, plus the procedure 'MakeChange'.

Mark

[klutz]

Greetings,

I tested dr's suggested in a blank wb (just for the first IF) and after ensuring there was a value in E27, entering a value in F27 was caught just fine.

Maybe a silly question, but are you sure you put the code in the correct worksheet's module?

If still not working, consider posting an example wb, or at minimum, all the code you have in the effected worksheet's module, plus the procedure 'MakeChange'.

Mark

Quite Amazing, since the original code look for column E to be a specific interior.color index of <>20 (light blue). It worked well without any values in column E but after reading GTOs post I tried it, i added a value and viola the great code works.

:doh: Question, why is it not looking for the interior color as before and now it looks for a value in column E? :dunno


Great...and many thanks...

[klutz]

It all works great when i have the sheet un-protected but when I protect it it does not work...:banghead: :banghead:

What do I :bug: doooooooooo.


Oh Mannnnnnnnnnnnnn

[Simon Lloyd]

Try this (don't forget to change password for your actual password:


Option Explicit
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:="password"
'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 two rows to not lose important formulas
If requiredRows < 4 Then
requiredRows = 4
End If

startRow = Target.Row
'count light blue cells to determine exisisting rows number
For r = startRow To startRow + 200
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("f" & 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
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
Me.Protect Password:="password"
End Sub

[mdmackillop]

I prefer to avoid complicated code in the event procedure itself. You can use it to call one or more procedures though, and move the complex stuff into manageble routines, which are more amenable to shared use and copying to other locations.

Option Explicit

Public Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count > 1 Then Exit Sub

If Target.Column = 6 Then
Call GoAndDoThings(Target)
Else
Application.Run "Personal.xls!Colourcells", Target
End If

' or

Select Case Target.Column
Case Is < 6
Call GoAndDoSomething(Target)
Case 6
Call GoAndDoSomethingElse(Target)
Case Else
'Do Nothing
End Select

End Sub

[GTO]

Greetings,


Quite Amazing, since the original code look for column E to be a specific interior.color index of <>20 (light blue). It worked well without any values in column E but after reading GTOs post I tried it, i added a value and viola the great code works.

Question, why is it not looking for the interior color as before and now it looks for a value in column E?


I would suggest we take a step back and take a look at things. The original code (the first sub) did not first check for a color. It first checked that we were only changing one cell (Target.Cells.Count) AND that we were in Column 6.

After that (but still before checking for the color), it then checks to see if the column to the left (Col 5 or "E") has something (anything) in it like thus:

If Target.Cells.Count = 1 _
And Target.Column = 6 Then
If Target.Offset(0, -1) <> "" Then
MsgBox "We made it to here", 0, vbNullString
End If
End If

You can try that in a blank/new wb...

Hence, the color check is only reached after the above, and although you may not have run into the cell (to the left) being blank before now, it was always a possibility (leastwise if I am reading correctly).

Now - while this may not be the most efficient manner in which to write this, let's see if we can get the code to do both parts. I would note that my take on the original code is a bit different than Dusty's and Simon's, as it appeared to me that the second bit doesn't check for only one cell being changed. Thus, my thought was that clearing cells (if in the correct range) is supposed to be able to fire the second bit. If that is incorrect, please say so, as I certainly don't want to steer us off the road and into a ditch...

Option Explicit

Public Sub Worksheet_Change(ByVal Target As Range)
Dim RequiredRows As Long
Dim StartRow As Long
Dim RowNumber As Long
Dim EndRow As Long
Dim ExistingRows As Long
Dim rngCell As Range

Const PWD As String = "MyPassword" '<---Change to match the password used.

'// First, we will check to ensure that on ly one cell has been changed //
'// AND that we are changing a cell's value in Col 6 //
'// AND that the cell to the left has some type of value in it. //
If Target.Cells.Count = 1 _
And Target.Column = 6 _
And Not Target.Offset(, -1).Value = vbNullString Then

Me.Unprotect Password:=PWD

RequiredRows = Target.Value

'Don't delete the first two rows, in order not to lose important information
If RequiredRows < 4 Then RequiredRows = 4
StartRow = Target.Row

'// Now we will check from the cell we just changed, to 200 cells below, to //
'// see if the cell to the left of ea cell we are checking is lt blu //
For RowNumber = StartRow To StartRow + 200 Step 1
If Not Cells(RowNumber, "E").Interior.ColorIndex = 20 Then
EndRow = RowNumber - 1
Exit For
End If
Next RowNumber

ExistingRows = EndRow - StartRow + 1

'// To prevent recursion to the Worksheet_Change Event, we disable events //
'// while we are programatically making changes. //
Application.EnableEvents = False

If RequiredRows > ExistingRows Then
'add rows
For RowNumber = ExistingRows To RequiredRows - 1
Rows(StartRow + RowNumber).Insert
Rows(StartRow + RowNumber - 1).Copy Destination:=Range("A" & StartRow + RowNumber)
Range("F" & StartRow + RowNumber & ":T" & StartRow + RowNumber).ClearContents
Next RowNumber
ElseIf RequiredRows < ExistingRows Then
'delete rows
Rows(StartRow + RequiredRows & ":" & StartRow + ExistingRows - 1).Delete
End If
'// Turn Application Events back on. //
Application.EnableEvents = True

Me.Protect Password:=PWD

'// I am not sure about this, but it appeared to me that changes to multiple //
'// cells (ie - clearing contents) would be allowed to fire the code (as long //
'// as the cells selected were within Col D, and at least some of the cells //
'// were within the Range of D24:D290). If that is correct, my guess would be //
'// that if the test is met, BUT, there are cells above/below our range, we //
'// wouldn't want to be changing those cells' color. If that is also correct, //
'// you may wish to review what's happening in 'MakeChange()' //
ElseIf Target.Columns.Count = 1 _
And Not Application.Intersect(Target, Range("D24:D290")) Is Nothing Then

Me.Unprotect Password:=PWD

For Each rngCell In Target.Cells
If rngCell.Value <> vbNullString Then
Call MakeChange(rngCell.Offset(, 3))
Else
If rngCell.Row >= 24 And rngCell <= 290 Then
rngCell.Interior.ColorIndex = 20
End If
End If
Next rngCell

Me.Protect Password:=PWD
End If
End Sub


If that gets things working, I would certainly take heed of Malcom's observation. If not, please post an example workbook so we can see what's going on (or not, as thecase may be). At least to me, its hard to see why we are checking colors in Col E, but changing colors in Col D...

Hope that helps,

Mark

[klutz]

Hi,

i have 2 codes in the same worksheet that perfomr different functions but both start with the same ----> Public Sub Worksheet_Change(ByVal Target As Range).

I need both codes in the same worksheet, what do i need to change to get them working?:dunno

Thanks


OK, thanks to all that helped me out with this. Works like a dandy...

Gracias...