• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Help Please!! - update this module to work for a Range of cells rather than just 1

M_Brookes

New Member
I have the below module which takes the value in A1 of the sheet "CC_Lookup", and searches through all other worksheet in the workbook for a match (there may be none, one or multiple matches in across multiple worksheets). Where the value is found at least once in a worksheet, it lists all the worksheets that the value is present in.

It works great, but I would like to be able to do the same, but not for one value at a time, but do the same as above for each value in a Range (e.g. instead of just A1, it does it for each value in the Range A1:A10, ignoring any cells that are blank in this range)

Could one of you fine people, help me extend the below to work with such a range?

Rich (BB code):
Sub ListSheetsWithStock()
' Defines Variables
Dim sRange As Range, Rng As Range, WS As Worksheet, FindString As String
' Disables screen updating to reduce screen flicker
    Application.ScreenUpdating = False
' Sets the item to be found as whateve value is in cell A1 of the Lookup sheet
        FindString = Sheets("CC_Lookup").Range("A1").Value
' For each sheet in your workbook
            For Each WS In ActiveWorkbook.Worksheets
' Defines LastRow1 as the first blank row in column A of the lookup sheet
                LastRow1 = Sheets("CC_Lookup").Cells(Rows.Count, "A").End(xlUp).Row + 1
' If the sheet name is not "Lookup" then
                    If WS.Name <> "Lookup" Then
' Activate the sheet
                        WS.Activate

                                Set sRange = ActiveSheet.Range("A1:AB15000")
' With the search range
                                        With sRange
' Set Rng as the cell where the search value is found
                                            Set Rng = .Find(What:=FindString, _
                                                            After:=.Cells(1), _
                                                            LookIn:=xlValues, _
                                                            LookAt:=xlWhole, _
                                                            SearchOrder:=xlByRows, _
                                                            SearchDirection:=xlPrevious, _
                                                            MatchCase:=False)
' If Rng exists then...
                                                If Not Rng Is Nothing Then
' Update the first blank row of column A on the lookup sheet with the relevant sheet name & the value it searched on
                                                        Sheets("CC_Lookup").Range("A" & LastRow1).Value = WS.Name & " - " & FindString
' Increase LastRow1 by 1 to account for the new data
                                                            LastRow1 = LastRow1 + 1
                                                    End If
                                    
                                        End With
                    End If
 
In the attached, there's your adjusted macro:
Code:
Sub ListSheetsWithStock()
' Defines Variables
Dim FindString As String, NotFoundOnAnySheet As Boolean, WS As Worksheet, Rng As Range, LastRow1 As Long, RngSearchValues As Range, Destn As Range, cll As Range
' Disables screen updating to reduce screen flicker
Application.ScreenUpdating = False
' Defines LastRow1 as the first blank row in column A of the lookup sheet
LastRow1 = Sheets("CC_Lookup").Cells(Rows.Count, "A").End(xlUp).Row    ' + 1
Set RngSearchValues = Sheets("CC_Lookup").Range("A1:A" & LastRow1)    'the range of cell with strings to be found.
RngSearchValues.Interior.Color = xlNone    'remove any pink colouring from the cells containing stings to be found
Set Destn = Sheets("CC_Lookup").Range("A" & LastRow1 + 2)    'where the first result will go.
For Each cll In RngSearchValues.Cells
  If Len(cll.Value) > 0 Then    'make sure there's something in the cell.
    FindString = cll.Value
    NotFoundOnAnySheet = True
    ' For each sheet in your workbook
    For Each WS In ActiveWorkbook.Worksheets
      ' If the sheet name is not "Lookup" then
      If WS.Name <> "CC_Lookup" Then
        ' Activate the sheet
        ' WS.Activate 'not needed
        ' Set Rng as the cell where the search value is found
        Set Rng = WS.Range("A1:AB15000").Find(What:=FindString, After:=WS.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
        ' If Rng exists then...
        If Not Rng Is Nothing Then
          Destn.Value = WS.Name & " - " & FindString
          Set Destn = Destn.Offset(1)    'make destination next cell down.
          NotFoundOnAnySheet = False    'used as a flag if FindString has been found on at least one sheet.
        End If
      End If
      ' Check next sheet in your workbook
    Next WS
    If NotFoundOnAnySheet Then cll.Interior.Color = 14868991    'colour cell with FindString in it pink
  End If
Next cll
'Sheets("CC_Lookup").Activate 'not needed as active sheet doesn't change.
Application.ScreenUpdating = True
End Sub
It also shades pink any values not found on any sheet.
 

Attachments

  • Chandoo41651CHANDOOSAMPLE.xlsm
    68.7 KB · Views: 1
Thank you so much! this is perfect.

Much appreciated

P.S. The pink shading addition is really helpful. Thanks again!
 
Last edited:
Back
Top