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;
<colgroup><col><col><col></colgroup><tbody>
</tbody>
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;
<tbody>
</tbody>
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
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;
MEMBER NUMBER | COLUMN1 | COLUMN2 |
123456 | ABC | |
123 | ABC123 | |
123 | TOTAL | |
123456 | TOTAL | |
<colgroup><col><col><col></colgroup><tbody>
</tbody>
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;
MEMBER NUMBER | COLUMN1 | COLUMN2 |
123 | ABC123 | |
123 | TOTAL |
<tbody>
</tbody>
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