Reputation: 569
I'm trying to put a "X" or what ever in a the next empty column that I later can use INDEX
and INDERECT
(since the sheets are named the same as the range in column A in my main sheet) to look up for my main sheet. The "X" needs to be added in each of the sheets where the value is found.
The column in the sheets where the numbers I need to find the value is always in column A. In my main sheet the values are listed from B2:B23
. The range varies in each sheet (from 400 to 5000 rows).
Is there a clever way of doing this that I haven't found still?
atm there are 80 sheets and the one main sheet
Code:
Sub Mark_cells_in_column()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim I As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Search for a Value Or Values in a range
MyArr = Array("34-2472", "36-437", "36-4351", "36-4879", "36-4982", "36-4981" _
, "36-5715", "36-4983", "36-4984", "36-5125", "36-5126", "36-5257", "36-6139" _
, "38-7079-1", "38-7079-2", "44-1276", "31-8589", "31-8589-1", "31-8647", "36-6149" _
, "36-5770", "31-8590")
'Search Column or range
With Sheets("3").Range("A:A") 'cant get my head around how to get this to apply so it loops through every sheet except main sheet
'clear the cells in the column to the right
.Offset(0, 13).ClearContents
For I = LBound(MyArr) To UBound(MyArr)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "values listed"
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
'mark the cell in the column to the right if "Values listed" is found
Rng.Offset(0, 13).Value = "X"
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Upvotes: 0
Views: 104
Reputation: 23285
Here you go:
Sub Mark_cells_in_column()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim I As Long
Dim mainWS As Worksheet, ws As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set mainWS = Sheets("Main") ' Change this to whatever the name of your Main WS is, that you DON'T want to run the macro on
'Search for a Value Or Values in a range
MyArr = Array("34-2472", "36-437", "36-4351", "36-4879", "36-4982", "36-4981" _
, "36-5715", "36-4983", "36-4984", "36-5125", "36-5126", "36-5257", "36-6139" _
, "38-7079-1", "38-7079-2", "44-1276", "31-8589", "31-8589-1", "31-8647", "36-6149" _
, "36-5770", "31-8590")
' Loop through Sheets
For Each ws In Worksheets
If ws.Name <> mainWS.Name Then
With ws
'Search Column or range
With .Range("A:A")
'clear the cells in the column to the right 13 columns (aka column N)
.Offset(0, 13).ClearContents
For I = LBound(MyArr) To UBound(MyArr)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "values listed"
Set Rng = .Cells.Find(What:=MyArr(I), _
After:=.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
'mark the cell in the column to the right if "Values listed" is found
Rng.Offset(0, 13).Value = "X" ' This marks it in 13 columns to the right where the value is found
Set Rng = .Columns("A:A").FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With ' Ends the .Range("A:A")
End With ' ends the `with WS`
End If
Next ws
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
The main thing seemed to be you were using the very last cell (After:=.Cells(.Cells.Count)
) with SearchDirection:=xlNext
. ...there's no next cell, if you're at the end! So, I changed that to After:=.Cells(1,1)
.
Secondly, I added a loop to check the worksheets, and if it's "Main", skip it. Edit as required.
Upvotes: 1