Requesting help to correct the codes

[anish.ms]

I'm just a beginner to VBA and in the middle of learning it. The attached one is my first project.
Request somebody's help in solving the following issues where I'm stuck.
(1) The code is working only in the first cell in case of multiple selection and deletion or paste values in columns "H" and "J"
(2) Where to keep the code if I need to use it in other sheets in the same workbook where the contents and format of the sheets will be same and how to refer the code to the required sheets?
Thanks in Advance for your Help!

[Paul_Hossler]

Very good for your first project.

1. To make available to all sheets, you need to put it into the ThisWorkbook module

2. You can loop the Target cells (I used a seperate sub)

3. You can sorten the code some what since you don't need to define so many variables. Nothing wrong -- your choice

I left 2 versions of the UpdateCell sub, one very similar to yours

4. Important to stop processing events if you're changing something that has an event handler.

So changing the sheet triggers Workbook_SheetChange event handler which changes the sheet which trigger Workbook_SheetChange etc.






Option Explicit


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rCell As Range
Dim iMax As Long


'make sure we're on correct type of sheet
If Sh.Cells(1, 1).Value <> "Function" Then Exit Sub

iMax = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row

For Each rCell In Target.Cells
If (rCell.Column = 8 Or rCell.Column = 10) And (2 <= rCell.Row) And (rCell.Row <= iMax) Then
Application.EnableEvents = False ' !!!! Important so this doesn't call itself in a loop
Call UpdateCell(rCell)
Application.EnableEvents = True
End If
Next
End Sub


Private Sub UpdateCell(R As Range)
With R.EntireRow
Select Case .Cells(8).Value
Case "Almost Certain"
.Cells(9).Value = 5
Case "Likely"
.Cells(9).Value = 4
Case "Possible"
.Cells(9).Value = 3
Case "Unlikely"
.Cells(9).Value = 2
Case "Rare"
.Cells(9).Value = 1
Case Else
.Cells(9).Value = 0
End Select

Select Case .Cells(10).Value
Case "Severe"
.Cells(11).Value = 5
Case "High"
.Cells(11).Value = 4
Case "Moderate"
.Cells(11).Value = 3
Case "Low"
.Cells(11).Value = 2
Case "Insignificant"
.Cells(11).Value = 1
Case Else
.Cells(11).Value = 0
End Select

.Cells(13).Value = .Cells(9).Value * .Cells(11).Value


Select Case .Cells(13).Value
Case 1 To 2
.Cells(12).Value = "Low"
.Cells(12).Interior.Color = VBA.RGB(129, 187, 66)
Case 3 To 9
.Cells(12).Value = "Moderate"
.Cells(12).Interior.Color = VBA.RGB(255, 192, 0)
Case 10 To 25
.Cells(12).Value = "High"
.Cells(12).Interior.Color = VBA.RGB(255, 0, 0)
Case Else
.Cells(12).Value = vbNullString
.Cells(12).Interior.Color = VBA.RGB(255, 255, 255)
End Select
End With
End Sub


'wordy version
Private Sub UpdateCellX(R As Range)
Dim Likelihood As String, Severity As String, Impact As String
Dim LikelihoodScore As Byte, SeverityScore As Byte, ImpactScore As Byte, ImpactColor As Long


With R.EntireRow
Likelihood = .Cells(8).Value
Select Case Likelihood
Case "Almost Certain"
LikelihoodScore = 5
Case "Likely"
LikelihoodScore = 4
Case "Possible"
LikelihoodScore = 3
Case "Unlikely"
LikelihoodScore = 2
Case "Rare"
LikelihoodScore = 1
Case Else
LikelihoodScore = 0
End Select

.Cells(9).Value = LikelihoodScore

Severity = .Cells(10).Value
Select Case Severity
Case "Severe"
SeverityScore = 5
Case "High"
SeverityScore = 4
Case "Moderate"
SeverityScore = 3
Case "Low"
SeverityScore = 2
Case "Insignificant"
SeverityScore = 1
Case Else
SeverityScore = 0
End Select

.Cells(11).Value = SeverityScore

ImpactScore = LikelihoodScore * SeverityScore

.Cells(13).Value = ImpactScore


Select Case ImpactScore
Case 1 To 2
Impact = "Low"
ImpactColor = VBA.RGB(129, 187, 66)
Case 3 To 9
Impact = "Moderate"
ImpactColor = VBA.RGB(255, 192, 0)
Case 10 To 25
Impact = "High"
ImpactColor = VBA.RGB(255, 0, 0)
Case Else
Impact = ""
ImpactColor = VBA.RGB(255, 255, 255)

End Select

.Cells(12).Value = Impact
.Cells(12).Interior.Color = ImpactColor
End With
End Sub

[anish.ms]

Thanks a lot for your help. Its Awesome
One doubt
The code works in all sheets where the value in cell A1 is "Function". What if I need to specify it to some sheets like Sheet3 to Sheet10?


If Sh.Cells(1, 1).Value <> "Function" Then Exit Sub


Also if I don't want to show zero in column M in case either column H or J is blank. I have added an if condition after the multiplication. Please guide, is it the right way to do it?

.Cells(13).Value = .Cells(9).Value * .Cells(11).Value

If .Cells(13).Value = 0 Then .Cells(13).Value = vbNullString Else .Cells(13).Value = .Cells(9).Value * .Cells(11).Value

[Paul_Hossler]

Thanks a lot for your help. Its Awesome
The code works in all sheets where the value in cell A1 is "Function". What if I need to specify it to some sheets like Sheet3 to Sheet10?


I thought the contents and format were the same????


in the same workbook where the contents and format of the sheets will be same

It's not very robust (forgiving) relying of a range of sheets like that. IMHO a 'signature' on the sheet is better (below). I added a check for the right value in B1.

Sheet3 to Sheet10 is doable, but I wouldn't recommend it



Also if I don't want to show zero in column M in case either column H or J is blank. I have added an if condition after the multiplication. Please guide, is it the right way to do it?




Option Explicit


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rCell As Range
Dim iMax As Long


'make sure we're on correct type of sheet
If Sh.Cells(1, 1).Value <> "Function" Then Exit Sub
If Sh.Cells(1, 2).Value <> "Sub Process" Then Exit Sub ' <<<<<<<<<<<<<<<<<<<<<

iMax = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row

For Each rCell In Target.Cells
If (rCell.Column = 8 Or rCell.Column = 10) And (2 <= rCell.Row) And (rCell.Row <= iMax) Then
Application.EnableEvents = False ' !!!! Important so this doesn't call itself in a loop
Call UpdateCell(rCell)
Application.EnableEvents = True
End If
Next
End Sub


Private Sub UpdateCell(R As Range)
With R.EntireRow
Select Case .Cells(8).Value
Case "Almost Certain"
.Cells(9).Value = 5
Case "Likely"
.Cells(9).Value = 4
Case "Possible"
.Cells(9).Value = 3
Case "Unlikely"
.Cells(9).Value = 2
Case "Rare"
.Cells(9).Value = 1
Case Else
.Cells(9).Value = 0
End Select

Select Case .Cells(10).Value
Case "Severe"
.Cells(11).Value = 5
Case "High"
.Cells(11).Value = 4
Case "Moderate"
.Cells(11).Value = 3
Case "Low"
.Cells(11).Value = 2
Case "Insignificant"
.Cells(11).Value = 1
Case Else
.Cells(11).Value = 0
End Select

.Cells(13).Value = .Cells(9).Value * .Cells(11).Value


Select Case .Cells(13).Value
Case 0 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
.Cells(13).ClearContents
Case 1 To 2
.Cells(12).Value = "Low"
.Cells(12).Interior.Color = VBA.RGB(129, 187, 66)
Case 3 To 9
.Cells(12).Value = "Moderate"
.Cells(12).Interior.Color = VBA.RGB(255, 192, 0)
Case 10 To 25
.Cells(12).Value = "High"
.Cells(12).Interior.Color = VBA.RGB(255, 0, 0)
Case Else
.Cells(12).Value = vbNullString
.Cells(12).Interior.Color = VBA.RGB(255, 255, 255)
End Select
End With
End Sub

[anish.ms]

Thanks for your advice and help!