Find Function - can it find the next number?

[nutsy]

Hi,
Please help, I have just started programming.
I need to extract some data from one sheet and place in another. My Macro was working fine until I noticed the data ranges have some inconsistency where at times the data in column A is missing a consecutive number : ie(3040014) is missing below in the monhtly data:​

Column A Rows B to M contain figures
3040012 amount
56654
555
22
3040013 Amount
56
3040015 Amount
456
4567
3040016 Amount ​

My Macro (below) FINDS the selected cost centre number ie 3040012 location and then FINDS the CostCentre number +1 ie 3040013 which sets up the range to be copied. This worked fine until I noticed some months a cost centre would not appear eg 3040014 so I couldn’t FIND the end row of the range for the cost centre above the missing costcentre ie 3040013.​

This is the part of the macro which selects range to be copied​

'Registers cost centre to search as variable (from named range "costcentre")
Searchfor = Range("CostCentre")
'Registers next cost centre to finish as (+1 to the Search For variable)
SearchEnd = Searchfor + 1​

‘If cost centre has no data for that month then it causes an error
On Error GoTo ErrHandler2:​

'Finds finds the cost centre the user has selected (start of the range to be copied)
Cells.Find(what:=Searchfor, After:=Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate​

‘This is the first row address of the range to be selected
CostCentreStart = ActiveCell.Address​

(This section causes an error if the next consecutive cost centre is missing as it searches for the costcentre number +1)
‘This finds the end of the Range to be selected
Cells.Find(what:=SearchEnd, After:=Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate​

‘This is the last row of the range to be copied
CostCentreFinish = ActiveCell.Offset(-1, 12).Address​

‘Copies the Range
Range(CostCentreStart & ":" & CostCentreFinish).EntireRow.Copy​

Is it possible to write into the macro to look for the next consecutive cost centre number if it cannot find the SearchEnd?​

Any help would be appreciated!!!​

Thanks
Nutsy​

 

[xenou]

Your test as stated will of course fail...no way around that. There appears to be other ways to test this, however.

For instance, it looks like all your cost center cells have "amount" in them. You can test for that. Other possibilities are to test for text instead of numbers. Since the cost center numbers are "large" in comparison to the in between numbers, you might also test for a certain limit value.

Here's an example of using the "amount" key. I'm not catching the last group (maybe my data is set up wrong...).

.Find and .FindNext is well-documented in the help files but here's some examples and tricks (finding the first match, then looking for the rest...)

Sub Test()
Dim CostCentreStart As String
Dim CostCentreFinish As String
Dim StartedAt As String
Dim r As Range

Set r = Cells.Find(what:="*amount", After:=Cells(Rows.Count, Columns.Count), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

'Set first row
If Not r Is Nothing Then
    StartedAt = r.Address
    CostCentreStart = r.Address
Else
    Exit Sub 'No matches
End If


'Start looping segments
Do
    Set r = Cells.FindNext(After:=Range(CostCentreStart))

    If r.Address <> StartedAt Then
        CostCentreFinish = r.Offset(-1, 12).Address
        Range(Range(CostCentreStart), Range(CostCentreFinish)).Select
        Application.Wait (Now + TimeValue("00:00:01"))
        CostCentreStart = r.Address 'reset new start
    Else
        'can we pick up the last bit here?
    End If
    
Loop While r.Address <> StartedAt

End Sub

Hope this helps

--------------

Edit, Thinking about this a bit more, I guess you could also just "if nothing is found, then increment by one and try again..." This would probably involve a judgement about how many missing gaps there are...and how many times to increment before giving up....you test for "nothing found" like this:

Dim r as range 'range object variable
Set r = Cells.Find(~~~)
If Not r Is Nothing Then 
    msgbox r.Address & " contains: " & r.Value
Else 
    msgbox "Nothing found"
End If

 

[nutsy]

Thanks Alex.

You were correct the message board moved my data. Column A only has the cost centre and it is blank until the next cost centre. The rest of the data is placed in columns B to M.
I will have need some time to go through your suggestion as I am new to this, will get back to you.

Thanks

 

[xenou]

Apropos of my edit above (why didn't I think of this at first?), this might be a quick fix you can "plug in":

Dim r As Range
Dim SearchEndLimit as Long

Set r = Nothing 'Prime loop control
SearchEndLimit = SearchEnd + 10 'Allow for ten missing cost center codes
Do While r Is Nothing And SearchEnd <= SearchEndLimit

    Set r = Cells.Find(what:=SearchEnd, After:=Range("A1"), LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
    
    If Not r Is Nothing Then
        CostCentreFinish = ActiveCell.Offset(-1, 12).Address
        Range(CostCentreStart & ":" & CostCentreFinish).EntireRow.Copy
    Else
        SearchEnd = SearchEnd + 1
    End If

Loop

Edit: Loop is exited when 1) either a cell is found -- r is something -- or 2) the searchEndLimit is reached (10 tries to find another higher cost center)

 

[nutsy]

Hi Alex,

I tried plugging in your code. If the next cost centre IS there it will find the cell but won't select select and copy the range. If the next cost centre is NOT there it just stops no loop to check again? Did I put it your code in the right place?

On Error GoTo ErrHandler2:
'Sets the current Sheet name as a Variable
OperatingStatementSheet = ActiveSheet.name
'Sets the current Window name as a Variable
OperatingStatementWindow = ActiveWorkbook.name

'Finds what cost centre to search for as on sheet as set in above procedure
Cells.Find(what:=Searchfor, After:=Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

CostCentreStart = ActiveCell.Address

Dim r As Range
Dim SearchEndLimit As Long
Set r = Nothing 'Prime loop control
SearchEndLimit = SearchEnd + 10 'Allow for ten missing cost center codes
Do While r Is Nothing And SearchEnd <= SearchEndLimit
Set r = Cells.Find(what:=SearchEnd, After:=Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

If Not r Is Nothing Then
CostCentreFinish = ActiveCell.Offset(-1, 12).Address
Range(CostCentreStart & ":" & CostCentreFinish).EntireRow.Copy
Else
SearchEnd = SearchEnd + 1
End If
Loop

Sorry if I'm a little bit slow on this.

Cheers

 

[xenou]

Hmmm...driving home I realized we have no control for starting on the next cost center. Here's one try:

Dim r As Range
Dim SearchEndLimit As Long
Dim blnEndOfCostCenters As Boolean

blnEndOfCostCenters = False
Do While Not blnEndOfCostCenters
    
    Set r = Nothing 'Prime loop control
    SearchEndLimit = SearchEnd + 10 'Allow for ten missing cost center codes
    Do While r Is Nothing And SearchEnd < SearchEndLimit
    
        Set r = Cells.Find(what:=SearchEnd, After:=Range("A1"), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        
        If Not r Is Nothing Then
            CostCentreFinish = ActiveCell.Offset(-1, 12).Address
            Range(CostCentreStart & ":" & CostCentreFinish).EntireRow.Copy
        Else
            SearchEnd = SearchEnd + 1
            If SearchEnd = SearchEndLimit Then blnEndOfCostCenters = True 'To provoke exit from outer loop
        End If
    
    Loop

Loop

 

[nutsy]

Hello again. Code now stops on the set R stage:
Set r = Cells.Find(what:=SearchEnd, After:=Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

When the next cost centre is available it does go and select the next consecutive costcentre but then gives Runtime error 424 - object required.

When the next cost centre is not available it doesn't select cell(obviously) gives Runtime Error 91 - Object Variable with block variable not set.

Hopefully you don't mind helping again.....