Macro to scan worksheets for ip addresses

Last Edited By Krjb Donovan
Last Updated: Mar 05, 2014 09:46 PM GMT

Question

I have a workbook with multiple spreadsheets to manage IPs I issue out. One of the worksheets has all the IP addresses I have and the other worksheets are the buildings that the IPs are in. On the worksheet that has all the IPs I want to have it scan the other worksheets and if it sees an IP that is in my main worksheet it colors that cell red.

Answer

Frank

assume the master list of IP addresses is in a worksheet named master and the IP addresses are listed in column A. Assume the IP addresses in Master start in cell A2.


Sub MarkinRed() Dim r As Range, rng1 As Range, rng As Range Dim v As Variant, i As Long, sh As Worksheet Dim sAddr As String With Worksheets("Master")

 Set r = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))

End With

v = r.Value

For Each sh In Worksheets

 If sh.Name <> Worksheets("Master").Name Then
   For i = LBound(v, 1) To UBound(v, 1)
    If Len(Trim(v(i, 1))) > 0 Then
     If Application.CountIf(sh.Cells, v(i, 1)) > 0 Then
       Set rng = Nothing
       Set rng1 = Nothing
       sAddr = ""
       
       Set rng = sh.UsedRange.Find(What:=v(i, 1), _
                 After:=sh.UsedRange(sh.UsedRange.Count), _
                 LookIn:=xlFormulas, _
                 LookAt:=xlWhole, _
                 SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, _
                 MatchCase:=False)
       If Not rng Is Nothing Then
         sAddr = rng.Address
         Do
           If rng1 Is Nothing Then
              Set rng1 = rng
           Else
              Set rng1 = Union(rng1, rng)
           End If
           Set rng = sh.UsedRange.FindNext(rng)
         Loop Until rng.Address = sAddr
         If Not rng1 Is Nothing Then
             rng1.Interior.ColorIndex = 3
         End If
       End If
     End If
    End If
   Next
 End If

Next End Sub


the above worked for me given the assumptions stated.


Test it on a copy of your workbook

Advertisement

©2024 eLuminary LLC. All rights reserved.