Loop through all sheets, use mid function and compare the result if same in all sheets

[AriannaVV]

I'm trying to use the following two codes I found to work as one task but only the first part works for me. What I'm trying to do is go through all sheets except the one named "WORKDONE" and use mid function to extract some digits from a specific cell to cell I6. That works ok. The problem comes from the second part where I want to check if cell I6 has the same value in all sheets except the first "WORKDONE". I know that the code below looks a bit messy but I'm not into vba that much. I'm just trying to make things easier. So your help is much appreciated. Thank you in advance for your kind attention and advice. I use excel 365.

Sub match()
Dim myValue, f
Dim sht As Worksheet
Dim count&
Dim ws As Worksheet
     For Each ws In Worksheets
        If ws.Name <> "WORKDONE" Then
            With ws
                .Range("I6").FormulaR1C1 = _
                "=MID(R[-2]C,8,6)"
                End With
                End If
                Next ws
   
  
myValue = Sheets("1").Range("I6").Value
    For Each sht In Sheets
    If sht.Name <> "WORKDONE" Then
        Set f = sht.Range("I6").Find(what:=myValue, Lookat:=xlPart)
        If Not f Is Nothing Then
            count = count + 1
        Else
            MsgBox sht.Name & " does not match"
            Exit Sub
        End If
        End If
    Next
     
        If count = Sheets.count Then
            MsgBox "allSame"
        Else
            MsgBox sht(Sheets.count).Name & " does not match"
        End If
End Sub

 

[DanteAmor]

Hello @AriannaVV
Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.


If it is not necessary to put the formula in each sheet, we can extract the digits from cell I4, try the following:

Sub compare_values_v1()
  Dim ws As Worksheet
  Dim ini As String, s As String, d As String
 
  For Each ws In Sheets
    If ws.Name <> "WORKDONE" Then
      s = Mid(ws.Range("I4").Value, 8, 6)
      If ini = "" Then ini = s
      If ini <> s Then d = ws.Name: Exit For
    End If
  Next
 
  MsgBox IIf(d = "", "allSame", d & " does not match")
End Sub

----- --​

If the formula is required, then try the following:

Sub compare_values_v2()
  Dim ws As Worksheet
  Dim ini As String,  s As String, d As String
 
  For Each ws In Sheets
    If ws.Name <> "WORKDONE" Then
      ws.Range("I6").Formula = "=MID(I4,8,6)"
      s = Mid(ws.Range("I4").Value, 8, 6)
      If ini = "" Then ini = s
      If ini <> s Then d = ws.Name: Exit For
    End If
  Next
 
  MsgBox IIf(d = "", "allSame", d & " does not match")
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------
​

 

[AriannaVV]

Hello @AriannaVV
Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.


If it is not necessary to put the formula in each sheet, we can extract the digits from cell I4, try the following:

Sub compare_values_v1()
  Dim ws As Worksheet
  Dim ini As String, s As String, d As String
 
  For Each ws In Sheets
    If ws.Name <> "WORKDONE" Then
      s = Mid(ws.Range("I4").Value, 8, 6)
      If ini = "" Then ini = s
      If ini <> s Then d = ws.Name: Exit For
    End If
  Next
 
  MsgBox IIf(d = "", "allSame", d & " does not match")
End Sub

----- --​

If the formula is required, then try the following:

Sub compare_values_v2()
  Dim ws As Worksheet
  Dim ini As String,  s As String, d As String
 
  For Each ws In Sheets
    If ws.Name <> "WORKDONE" Then
      ws.Range("I6").Formula = "=MID(I4,8,6)"
      s = Mid(ws.Range("I4").Value, 8, 6)
      If ini = "" Then ini = s
      If ini <> s Then d = ws.Name: Exit For
    End If
  Next
 
  MsgBox IIf(d = "", "allSame", d & " does not match")
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------
​

omg this code is a piece of jewel! Works like a charm. Thank you so much. That was a huge help for me!!! Respect