Hi all ...
Thanks to a couple of very helpful members, this is the code that I use to identify duplications in E7:E16 and H7:H16.
Now, I also need to look for dupes between E17:E26 and H17:H26 and also between E27:E36 and H27:H36 etc. right through to comparing E307:E316 and H307:H316. As you can see, each set of cells is a group of 10.
Is there a way that I can add these comparisons to the existing code by way of a loop or something similar, or do I need to rewrite a separate routine for each set to be compared?
Regards ... G-fer.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim myRange As Range
Dim ChangedRange As Range
Dim c As Range
Set myRange = Sh.Range("e7:e16,h7:h16")
Set ChangedRange = Intersect(Target, myRange)
If Not ChangedRange Is Nothing Then
For Each c In ChangedRange
If c.Value <> "" And _
(WorksheetFunction.CountIf(myRange.Columns(1), c.Value) _
+ WorksheetFunction.CountIf(myRange.Columns(4), c.Value)) > 1 _
Then
MsgBox UCase(c.Value) & " is crewing the other aircraft"
End If
Next
End If
Set myRange = Nothing
Set ChangedRange = Nothing
Application.EnableEvents = False
If Not Intersect(Target, Sh.Range("e8:e320,h7:h320")) Is Nothing Then
Target(1).Value = UCase(Target(1).Value)
End If
Application.EnableEvents = True
End Sub
Thanks to a couple of very helpful members, this is the code that I use to identify duplications in E7:E16 and H7:H16.
Now, I also need to look for dupes between E17:E26 and H17:H26 and also between E27:E36 and H27:H36 etc. right through to comparing E307:E316 and H307:H316. As you can see, each set of cells is a group of 10.
Is there a way that I can add these comparisons to the existing code by way of a loop or something similar, or do I need to rewrite a separate routine for each set to be compared?
Regards ... G-fer.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim myRange As Range
Dim ChangedRange As Range
Dim c As Range
Set myRange = Sh.Range("e7:e16,h7:h16")
Set ChangedRange = Intersect(Target, myRange)
If Not ChangedRange Is Nothing Then
For Each c In ChangedRange
If c.Value <> "" And _
(WorksheetFunction.CountIf(myRange.Columns(1), c.Value) _
+ WorksheetFunction.CountIf(myRange.Columns(4), c.Value)) > 1 _
Then
MsgBox UCase(c.Value) & " is crewing the other aircraft"
End If
Next
End If
Set myRange = Nothing
Set ChangedRange = Nothing
Application.EnableEvents = False
If Not Intersect(Target, Sh.Range("e8:e320,h7:h320")) Is Nothing Then
Target(1).Value = UCase(Target(1).Value)
End If
Application.EnableEvents = True
End Sub