Increase Scope Of A Routine

[G-fer]

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

 

[Peter_SSs]

First, a request: When posting code, please use either:
a) code tags so your code looks like this:

Sub Test()
    Dim r As Integer
    
    For r = 1 To r
        If Cells(r, 5) > 0 Then
            Cells(r, 4).Interior.ColorIndex = 3
        End If
    Next rr
End Sub

or
b) the VBHTML Maker VBHTML maker so it looks like this:

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Test()<br>    <SPAN style="color:#00007F">Dim</SPAN> r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br>    <br>    <SPAN style="color:#00007F">For</SPAN> r = 1 <SPAN style="color:#00007F">To</SPAN> r<br>        <SPAN style="color:#00007F">If</SPAN> Cells(r, 5) > 0 <SPAN style="color:#00007F">Then</SPAN><br>            Cells(r, 4).Interior.ColorIndex = 3<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> rr<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

By showing the indentations etc, it makes your code much easier to read. A number of the vba experts on the board tend to not look closely at your code if it is not formatted that way and that will reduce your chance of getting the best answer.

Anyway, back to your problem. I believe a few small changes should allow a loop to work. I think the only changes I made are between the two pairs of ******* lines. Try this:

<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_SheetChange(<SPAN style="color:#00007F">ByVal</SPAN> Sh <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">Dim</SPAN> myRange <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> ChangedRange <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#007F00">'*********</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><br>    <SPAN style="color:#00007F">For</SPAN> r = 7 <SPAN style="color:#00007F">To</SPAN> 307 <SPAN style="color:#00007F">Step</SPAN> 10<br>        <SPAN style="color:#00007F">Set</SPAN> myRange = Union(Sh.Range("E" & r).Resize(10), Sh.Range("H" & r).Resize(10))<br>    <SPAN style="color:#007F00">'**********</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> ChangedRange = Intersect(Target, myRange)<br>        <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> ChangedRange <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> ChangedRange<br>                <SPAN style="color:#00007F">If</SPAN> c.Value <> "" And _<br>                    (WorksheetFunction.CountIf(myRange.Columns(1), c.Value) _<br>                    + WorksheetFunction.CountIf(myRange.Columns(4), c.Value)) > 1 _<br>                    <SPAN style="color:#00007F">Then</SPAN><br>                        MsgBox UCase(c.Value) & " is crewing the other aircraft"<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Next</SPAN> c<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> myRange = <SPAN style="color:#00007F">Nothing</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> ChangedRange = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#007F00">'**********</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> r<br>    <SPAN style="color:#007F00">'**********</SPAN><br>    Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Intersect(Target, Sh.Range("e8:e320,h7:h320")) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>    Target(1).Value = UCase(Target(1).Value)<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[G-fer]

Hello again Peter,

Thanks for the reply. Sorry, I didn't know about the formatting, but I'll be sure to practice it in future.

You may have recognized the code ... most of it was yours (with a couple of small changes)

Well, I'll give this a shot and let you know how it goes.

Regards ... G-fer.

 

[Peter_SSs]

Hello again Peter,

Thanks for the reply. Sorry, I didn't know about the formatting, but I'll be sure to practice it in future.

You may have recognized the code ... most of it was yours (with a couple of small changes)

Well, I'll give this a shot and let you know how it goes.

Regards ... G-fer.

Yes, I did recognise the code but good to see you getting in and trying to modify it yourself, rather than just asking on the board for every change.

 

[G-fer]

Thanx Peter ... worked beautifully

G-fer.