VBA Find Value and paste ll in between value if seen twice in search (if not, report single)

[steveaus]

Hi All,

I've inherited a spreadsheet here and it has stopped working. The macro currently finds a value and reports lines from the data in a new sheet. If the value is found twice it will report every cell in between the first and last value. Example data;

[TABLE="width: 553"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]MEMBER NUMBER[/TD]
[TD]COLUMN1[/TD]
[TD]COLUMN2[/TD]
[/TR]
[TR]
[TD]123456[/TD]
[TD]ABC[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]ABC123[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]TOTAL [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]123456[/TD]
[TD]TOTAL [/TD]
[TD]

[/TD]
[/TR]
</tbody>[/TABLE]

If i input 123456 into the function box and hit the macro, it will report all of the above. If i use 123 it will report;

[TABLE="width: 553"]
<tbody>[TR]
[TD]MEMBER NUMBER[/TD]
[TD]COLUMN1[/TD]
[TD]COLUMN2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]ABC123[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]123[/TD]
[TD]TOTAL [/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]

The current macro that is written is here;

Sub createReport()
Dim i As Long
Dim j As Long


Sheet2.Activate
Dim temp As String
Dim str As Variant




temp = Sheet1.TextBox21.value
i = findmin(temp)
j = findmax(temp, i)




If (i = 0 Or j = 0) Then

MsgBox "Account Number Not Found"
Sheet1.Activate
Exit Sub

End If

Sheet3.Cells.Clear
Rows("1:1").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("Report").Select
Rows("1:1").Select
ActiveSheet.Paste
'Application.CutCopyMode = False

Sheet2.Activate

Sheet2.range("A" & i & ":" & "N" & j).Select
Selection.Copy
Sheet2.range("A1").Select
Sheet3.Activate
range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Cells.Select
Selection.Columns.AutoFit
range("A1").Select



MsgBox "Report Created"
End Sub


Function findmin(findvalue As Variant) As Long
Sheet2.Activate
Dim j As Long
Dim i As Long
Dim str As Variant
j = [A1000000].End(xlUp).Row

For i = 2 To j
'MsgBox Cells(i, 1).Value

str = Cells(i, 1).value
If (Mid(str, 1, 1) = "0") Then
If (str / 1 = findvalue / 1) Then
Cells(i, 1).Select
'MsgBox "found At " & i
findmin = i
Exit Function
'i = i + 1
Else
'i = i + 1
'Cells(i, 1).Select
End If
Else

End If
Next i
findmin = 0
Exit Function
End Function


Function findmax(findvalue As Variant, endpoint As Long) As Long
Sheet2.Activate
Dim j As Long
Dim i As Long
i = endpoint
Dim str As Variant
j = [A1000000].End(xlUp).Row

For j = j To i + 1 Step -1
str = Cells(j, 1).value
If (Mid(str, 1, 1) = "0") Then
If (str / 1 = findvalue / 1) Then
Cells(j, 1).Select

findmax = j
Exit Function

Else

End If
Else

End If
Next j
findmax = 0
Exit Function
End Function


At the moment, it doesn't find anything even if i'm searching for something I Know is within the data...

Any ideas? Or a way to simplify ? Or even to create a filter which can do this instead of a macro?

Thanks and appreciate ANY help anyone can give!

Regards,
Steve