Help, I did have this code working but made some changes and lost a save when my pc crashed.
Cant seem to get the following 2 lines right?
MyArr(I, 2) = Rng.Offset(0, 1).Value
MyArr(I, 3) = Rng.Offset(0, 2).Value
This code basically searches all worksheets for each value in an array, when it finds each value it needs to add 2 offset values from the found values next to the original value in the array (thats the bit im stuck on). Cant see what im not doing, staring me in the face no doubt?
This is the whole code:
Option Explicit
Sub Mark_Cells_In_Column()
 Dim Rng                As Excel.Range
 Dim Sh                 As Excel.Worksheet
 Dim rngBins            As Excel.Range
 Dim MyArr              As Variant
 Dim scpSheets          As Object
 Dim FirstAddress       As String
 Dim I                  As Long

 Sheets("Sheet1").Select
 With Application
    .ScreenUpdating = False
    .EnableEvents = False
 End With
 Set rngBins = Range("A:A")
 MyArr = rngBins.Value
 Set scpSheets = CreateObject("Scripting.Dictionary")
 scpSheets.CompareMode = 1
 For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Sheet1" Then
        With Sh.Range("A:A")
            For I = LBound(MyArr) To UBound(MyArr)
                If MyArr(I, 1) <> "" Then
                    Set Rng = .Find(What:=MyArr(I, 1), After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, MatchCase:=False)
                    If Not Rng Is Nothing Then
                        FirstAddress = Rng.Address
                        If Not scpSheets.Exists(Sh.Name) Then
                            scpSheets.Item(Sh.Name) = Sh.Index
                        End If
                        Do
                            MyArr(I, 2) = Rng.Offset(0, 1).Value
                            MyArr(I, 3) = Rng.Offset(0, 2).Value
                            Set Rng = .FindNext(Rng)
                        Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
                    End If
                End If
            Next I
        End With
    End If
 Next Sh
 Set Rng = Nothing
 Set rngBins = Nothing
 With Application
    .ScreenUpdating = True
    .EnableEvents = True
 End With
End Sub