krib
krib

Reputation: 569

Find a value from a range of cells in column over many sheets and return a "X" in next empty column

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

Answers (1)

BruceWayne
BruceWayne

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

Related Questions