VBA to list cell address for cells containing specific text

[controller_bbs]

Hello,

I have a large data base , A1:DU3459, I need a way to list the address of cells inside the data base that contain specific text. Any help will be much appreciated

 

[jmacleary]

This will ask you for the string to find then create a msgbox with one reference per line - modify to suit your specific needs:

Sub ListAll()
Dim FindText As String
Dim ListText As String
FindText = InputBox("Please enter the string to find")
Dim Onecell As Range
For Each Onecell In Range("A1:DU3459")
    If InStr(Onecell.Text, FindText) > 0 Then
        ListText = ListText + vbNewLine + Onecell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
        End If
Next Onecell
MsgBox ListText
End Sub

 

[ParamRay]

Can use a macro to do the search:

Public Sub SearchForText()
  Dim rngSearchRange As Range
  Dim vntTextToFind As Variant
  Dim strFirstAddr As String
  Dim lngMatches As Long
  Dim rngFound As Range
  
  On Error GoTo ErrHandler
  vntTextToFind = Application.InputBox( _
    Prompt:="Enter text to find:", _
    Default:="Search...", _
    Type:=2 _
  )
  If VarType(vntTextToFind) = vbBoolean Then Exit Sub
  
  On Error Resume Next
  Set rngSearchRange = Application.InputBox( _
    Prompt:="Enter range for search:", _
    Default:=ActiveCell.Parent.UsedRange.Address, _
    Type:=8 _
  )

  On Error GoTo ErrHandler
  If rngSearchRange Is Nothing Then Exit Sub
  Set rngFound = rngSearchRange.Find( _
    What:=CStr(vntTextToFind), _
    LookIn:=xlValues, _
    LookAt:=xlPart _
  )
  
  If rngFound Is Nothing Then
    MsgBox "No matches were found.", vbInformation
  Else
    With ThisWorkbook.Sheets.Add
      With .Range("A1:B1")
        .Value = Array("Cell", "Value")
        .Font.Bold = True
      End With
      strFirstAddr = rngFound.Address
      Do
        lngMatches = lngMatches + 1
        .Cells(lngMatches + 1, "A").Value = rngFound.Parent.Name & "!" _
                                          & rngFound.Address(0, 0)
        .Cells(lngMatches + 1, "B").Value = rngFound.Value
        Set rngFound = rngSearchRange.FindNext(rngFound)
      Loop Until (rngFound.Address = strFirstAddr)
      .Columns("A:B").AutoFit
    End With
  End If
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation
End Sub