Cells.find in loop error -> return to the beginning of loop

[ondrej.kanta]

Hi all,

I have written the following code. I'm sorry it's in czech, however, the only word you need to know is "ucet" which means "an account", so please do not pay attention to the 'comments and other stuff :

blah blah imo not important part of code

Do Until ucet = "" 'Vložení čísla účtu do proměnné

Application.ScreenUpdating = False

ucet = InputBox("Zadejte číslo účtu, který chcete vložit", "Zadání účtu", "XXXXXX")

Sheets("data").Select 'Hledání ve sloupci podle vloženého čísla účtu
Range("A1").Select

With Sheet1
Cells.Find(What:=ucet, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
End With

'Označení oblasti ke kopírování
Range(ActiveCell, Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp)).Find(What:="Opening Balance", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)).Select

Range(Selection, Cells(ActiveCell.Row, 40)).Select

Selection.Copy 'Kopírování
Sheets("vystup").Select
Range("A1048576").Select
Selection.End(xlUp).Offset(3, 0).Select
Application.ScreenUpdating = True
ActiveSheet.Paste
    Application.CutCopyMode = False
    
Range(Selection, Selection.End(xlDown)).Select 'Kvůli zobrazení
Application.Goto ActiveCell

Loop

blah blah imo not important part of code

I use it to rearrange accounting reports according to the needs of clients. Accounts are in A:A, user (me) enters acc number into inputbox, it finds the start of block of all items belonging to the entered acc, selects rows to "Opening balance" which is the end of block, copies to output sheet and repeats until cancel.

The problem appears when user enters an acc number which does not appear in A:A and the macro crashes.

Could you please help me fix it? What I was thinikg of doing was to show MsgBox("Acc does not exist, please retry.") and return to the beginning of the loop, but I'm just an advanced beginner in VBA (or coding at all).

Many thanks!

[GTO]

Hi there,

I am not exactly following, as if the records are entered in "blocks", I would assume that there are "Opening Balance" entries at the end of each "block"; that is, more than one "Opening Balance" entry in column A. So, I must be misunderstanding that part, as this would result in the last "Opening Balance" entry always setting the end of the range to be copied.

Anyways, see if this is a tiny help; just to the part about eliminating errors if the value being sought is not found.

In a JUNK COPY of your workbook, in a Standard Module:

[vba]Option Explicit

Sub Example()
Dim wks As Worksheet
Dim rngAcct As Range
Dim rngEndAcct As Range
Dim rngEnd As Range
Dim ucet As Variant
Dim Cancel As Boolean

Set wks = ThisWorkbook.Worksheets("vystup")

Do
ucet = InputBox("Zadejte císlo úctu, který chcete vložit", "Zadání úctu")
'// Check to ensure the user entered some value by checking the length of the //
'// returned value. //
If Len(ucet) = 0 Then
MsgBox "Cancelled due to no search value...", vbInformation, "Entry Error"
Exit Do
End If
'// Attempt to Set a reference to the returned Range from .Find. If the value //
'// sought was not found, no reference is Set, thus we may check for Is Nothing //
'// This eliminates the error from trying to Select a Range that Is Nothing. //
Set rngAcct = _
RangeFound(Sheet1.Columns(1), ucet, Sheet1.Cells(1), xlValues, , xlByColumns, xlNext)
If rngAcct Is Nothing Then
Cancel = _
Not MsgBox("Value not found. Retry?", vbQuestion Or vbYesNo, vbNullString) = vbYes
Else
Set rngEnd = RangeFound(Sheet1.Range(rngAcct, Sheet1.Cells(Sheet1.Rows.Count, "A")))

Set rngEndAcct = RangeFound(Range(rngAcct, rngEnd), "Opening Balance", rngAcct, , _
xlWhole, xlByColumns, , True)

If rngEndAcct Is Nothing Then
Cancel = _
Not MsgBox("No ""Opening Balance"" entry. Retry?", _
vbQuestion Or vbYesNo, "Error") = vbYes
GoTo Jump
End If
Range(rngAcct, rngEndAcct).Resize(, 40).Copy wks.Cells(1).End(xlUp).Offset(3)
Application.CutCopyMode = False
End If
Cancel = _
Not MsgBox("Would you like to continue?", vbQuestion Or vbYesNo, vbNullString) = vbYes
Jump: Loop While Not Cancel
End Sub

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function[/vba]

Also, in your code, see where you have:
[vba]
With Sheet1
Cells.Find(...
[/vba]
You need a dot directly in front of 'Cells' to get it to belong to Sheet1. For example, let us say that we had an Object named 'Person' and Person had Properties such as Height, Weight, EyeColor, HairColor, Sex, and so on. To use With, we'd have code similar to:
[vba]
Dim Mark as Person

Set Mark = New Person

With Mark
.Height = 73
.Sex = "Male"
End With
[/vba]

Hope that helps,

Mark