search on sheet change an print results

[sjpriest79]

Hi guys

I found this search on sheet change on youtube and have used it in my code as it did look rather impressive.

idea is here you select a search range, a search input cell and output cell for the results. You then enter you search term and if prints all matches in and below the output cell selected. I have stepped through the code time and time again, but can't seem to get it working so after some help. The code runs but I'm not getting any output.

This is where I found the example https://www.youtube.com/watch?v=5rPdt9L_MSU

First part is against the workbook and set to sheet change

Private Sub Workbook_sheetChange(ByVal sh As Object, ByVal target As Range)
Dim i As Integer
Dim flag As Integer
Dim searchterm As Variant
flag = 0
i = 0

On Error Resume Next
'only do if search changes
If target.Address = RNGSearch.Address And RNGSearch.Value <> "" Then
If printing = 0 Then
' if not printing sheet change
Call ReDimOutput
Call ClearOldOutput
End If

searchterm = RNGSearch.Value
For Each c In RNGInput.Cells
If IsDate(c.Value) Or IsNumeric(c.Value) Then
If InStr(1, c.Value, searchterm) Then
Call AddToOutput(c.Value, 1)
flag = 1
End If
ElseIf InStr(1, LCase(c.Value), LCase(searchterm)) Then
Call AddToOutput(c.Value, 1)
flag = 1
End If
Next c
End If
If flag = 1 Then
Call printOutput(output)
End If
End Sub




The rest of the code below is in a general module

Public RNGInput As Range
Public RNGOutput As Range
Public RNGSearch As Range
Public output() As Variant
Public arr() As Variant
Public printing As Integer
Sub EnterUserInputForSearch()
On Error Resume Next
On Error GoTo Canceled
Range("RNGSearch").ClearContents
'get info from User
Set RNGInput = Excel.Application.InputBox("Enter a range of Input:", "Input", Selection.Address, , , , , 8)
Set RNGSearch = Excel.Application.InputBox("Enter a cell for the search:", "Search Term", Selection.Address, , , , , 8)
Set RNGOutput = Excel.Application.InputBox("Enter a cell for the Output:", "Output", Selection.Address, , , , , 8)
'enter text in cells
RNGSearch = "Enter Search Here"
RNGOutput = "Output"
'Set named ranges
ActiveWorkbook.Names.Add Name:="TotalOutPut", RefersTo:="=OFFSET(RngOutput,0,0,0,1)"
ActiveWorkbook.Names.Add Name:="RNGSearch", RefersTo:=RNGSearch
ActiveWorkbook.Names.Add Name:="RNGOutput", RefersTo:=RNGOutput
Canceled:
End Sub
Sub AddToOutput(Val As Variant, index As Integer)
'add valur to array
output(index) = Val
index = index + 1
ReDim Preserve output(index)
End Sub
Sub ReDimOutput()
'resize the old output
ReDim output(0)
End Sub
Sub ClearOldOutput()
'Clear old output
Range("TotalOutput").Select
Selection.ClearContents
RNGOutput.ClearContents
End Sub
Sub printOutput(arr() As Variant)
printing = 1
'print results of output range
RNGOutput.Select
col = ActiveCell.Column
Row = ActiveCell.Row
'loop array and print
For i = 0 To UBound(arr) - 1
Cells(Row, col).Value = arr(i)
Row = Row + 1
Next i
printing = 0
' update output as range
ActiveWorkbook.Names.Add Name:="TotalOutPut", RefersTo:="=OFFSET(RngOutput,0,0," & UBound(arr) & ",1)"
End Sub