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
Bookmarks