sub or function not defined in vba

[kanchan choudhary]

Hi All,

i am getting a error sub or function not defined in vba, can any one help.

Sub xyz()

counter = 1
Sheets("Sheet3").Select
For k = 6 To 200000

DOBval = Cells(k, 1)
If Mid(DOBval, Find("", DOBval + 1, 6)) = "App.No" Then
DOB = Cells(k + 1, 1)
counter = counter + 1
Worksheets("Output").Cells(counter, 6) = DOB
DOB = ""
End If
Next k
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

If Mid(DOBval, Find("", DOBval + 1, 6)) = "App.No" Then

Find is a worksheet function, not a vba function. Try the vba function InStr() or explain clearly in words what you are trying to do.

 

[Misca]

Welcome to the Msg Board!

I'm not 100 % I can understand what it is you want your code to do but here's my best guess:

Sub Bus()


Dim Found As Range
Dim c As Range


With Sheets("Sheet3")
    Set Found = Find_Range("App.No", .Range("A6:A200000"), xlValues, xlPart, True) 'Find cells where part of the value equals "App.No"


    If Not Found Is Nothing Then
        For Each c In Found
            'Write the value of the cell below to Output sheet:
            Sheets("Output").Cells(.Rows.Count, 6).End(xlUp).Offset(1).Value = c.Offset(1).Value
        Next c
    End If


End With


End Sub

End Sub




Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As Variant, _
    Optional LookAt As Variant, _
    Optional MatchCase As Boolean) As Range
     
    Dim c As Range
    If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
    If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
    If IsMissing(MatchCase) Then MatchCase = False
     
    With Search_Range
        Set c = .Find( _
        What:=Find_Item, _
        LookIn:=LookIn, _
        LookAt:=LookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=MatchCase, _
        SearchFormat:=False)
        If Not c Is Nothing Then
            Set Find_Range = c
            firstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
     
End Function

My solution is based on the awesome Kickbutt VBA Find Function found on https://www.ozgrid.com/forum/forum/tip-tricks-code/17729-kickbutt-vba-find-function

 

[kanchan choudhary]

Hi Thanks for your reply.

i am trying to find App.No with the help of mid and find function .
if the data has App.no then copy below cell to output sheet in column F

Example . Cell A6 has data "1 App.No.:88629" and cell A7 has DAPOLI 22/05/1982 and so on


Hope now its clear

Thanks
Kanchan

 

[Dossfm0q]

If Mid(DOBval, Find("", DOBval + 1, 6)) = "App.No" Then

Sub xyz()

counter = 1
Sheets("Sheet3").Select
For k = 6 To 20


DOBval = Cells(k, 1)
Fnd = WorksheetFunction.Find("", DOBval, 1)
If Mid(DOBval, Fnd, 6) = "App.No" Then
DOB = Cells(k + 1, 1)
counter = counter + 1
Worksheets("Output").Cells(counter, 6) = DOB
DOB = ""
End If
Next k
End Sub

 

[Peter_SSs]

If you really have 200,000 rows of data, then you might find an approach like this is quite fast.
Test in a copy of your workbook.

Sub xyz_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
  
  With Sheets("Sheet3")
    a = .Range("A6", .Range("A" & .Rows.Count).End(xlUp)).Value
  End With
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a) - 1
    If InStr(1, a(i, 1), "App.No", vbTextCompare) > 0 Then
      k = k + 1
      b(k, 1) = a(i + 1, 1)
    End If
  Next i
  If k > 0 Then Sheets("Output").Range("F1").Resize(k).Value = b
End Sub

 

[kanchan choudhary]

Thanks.. yes its working now.

 

[Peter_SSs]

Thanks.. yes its working now.

Glad it is resolved. Thanks for letting us know.