Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Visual basic split name

Status
Not open for further replies.

JohnJoker

Technical User
Oct 19, 2010
16
GB
I have the following code I need help because it does not work.




Private Sub Command0_Click()
Dim NUMCHECK As Integer
Dim SURN As String
Dim CD As String
Dim CURCH As String
Dim PREVNO As String
Dim ADNUM As String
Dim PREVCH As String
Dim LONGA As Integer
Dim C1 As String
Dim C2 As String
Dim C3 As String
Dim C4 As String
Dim C5 As String
Dim C6 As String
Dim VOWEL As String
Dim WH As String
Dim dbSpecimen As Object
Dim rst As Object
Dim fldEnumerator As Object
Dim fldColumns As Object

'Set dbSpecimen = CurrentDb
'Set rst = dbSpecimen.OpenRecordset("HiCUP surv")
'Set fldColumns = rst.Fields

' Scan the records from beginning to each
VOWEL = "AEIOUY',."
WH = "WH '-"
C1 = "BFPV"
C2 = "CGJKQSXZ"
C3 = "DT"
C4 = "L"
C5 = "MN"
C6 = "R"

Set db = CurrentDb()
Set rst = db.OpenRecordset("TestPertussis")
'Useful code here.
While Not rst.EOF
For Each fldEnumerator In rst.Fields
rst.Edit
If Confirmation = "confirmed measles" And (IsNull(Soundex1) = True) And (IsNull(PATIENTNAM) = True) Then

Exit Sub
End If

If Confirmation = "confirmed measles" And (IsNull(Soundex1) = False) And (IsNull(PATIENTNAM) = True) Then

'message current item number

LONGA = Left(PATIENTNAM, 1)

MsgBox (LONGA)
NUMCHECK = 0
PR = 0
Do While NUMCHECK = 0 And PR < LONGA
PR = PR + 1
If InStr("1234567890", (Mid("PATIENTNAM", 1)), PR, 1) > 0 Then
NUMCHECK = 1
End If

If NUMCHECK = 0 Then
SURN = Left(Surname, 1)
LONGA = Len(PATIENTNAM)

If (Left(PATIENTNAM, 3) = "ST " Or Left(PATIENTNAM, 3) = "ST.") Then
SURN = ("SAINT" & Mid(PATIENTNAM, 4, LONGA - 3))
If Mid(SURN, 6, 1) = " " Then
SURN = ("SAINT" & Mid(PATIENTNAM, 5, LONGA - 4))
End If
SURN = Left(SURN, 1)
End If
LONGA = Len(SURN)
If LONGA <= 2 Then
SURN = Left(PATIENTNAM, 2)
LONGA = Len(SURN)

End If
PR = 0
CD = (Left(SURN, 1) & "-")
PREVNO = ""
CURCH = ""
Do While PR < LONGA And Len(CD) < 5 'DO
PR = PR + 1
ADNUM = ""
CURCH = Mid(SURN, PR, 1)
If InStr(WH, CURCH) = 0 Then
If InStr(VOWEL, CURCH) = 0 Then
If InStr(C1, CURCH) > 0 Then
ADNUM = "1"
Else
If InStr(C2, CURCH) > 0 Then
ADNUM = "2"
Else
If InStr(C3, CURCH) > 0 Then
ADNUM = "3"
Else
If InStr(C4, CURCH) > 0 Then
ADNUM = "4"
Else
If InStr(C5, CURCH) > 0 Then
ADNUM = "5"
Else
If InStr(C6, CURCH) > 0 Then
ADNUM = "6"
End If
End If
End If
End If
End If
End If
If ADNUM = PREVNO And PR > 1 Then
If PREVCH = "V" Then
CD = (CD & ADNUM)
End If
Else
If InStr("123456", ADNUM) > 0 And PR > 1 Then
CD = (CD & ADNUM)
End If
End If
PREVNO = ADNUM
Else
If InStr(C6, CURCH) > 0 Then
ADNUM = "6"
End If
End If
End If
'End If
'End If
'End If
If ADNUM = PREVNO And PR > 1 Then
If PREVCH = "V" Then
CD = (CD & ADNUM)
End If
Else
If InStr("123456", ADNUM) > 0 And PR > 1 Then
CD = (CD & ADNUM)
End If
End If
PREVNO = ADNUM

'End If


rst.Update
'Next

' Move to the next record and continue the same approach
rst.MoveNext

'Wend


Loop
End If
rst.Close

Set rst = Nothing

End Sub
 



it does not work
Do you mean you get an ERROR? If so, what error on what statement.

Do you mean that you get an incorrect result? If so, what result and what expected result?

It would be helpful to know what data you access and exactly what results you expect from that data.

Help yourself out!

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
The error I am getting is: Compile Error, Do without loop.
I am trying to assign value to a field= First letter of Firstname + first letter of Surname + numbers whatever they are according the codes given. Does it make sense?
i.e FIELD=WH616.

Thanks
 
Well, you have 2 "Do" statements:
Do While NUMCHECK = 0 And PR < LONGA
and
Do While PR < LONGA And Len(CD) < 5 'DO

but only 1 "Loop" statement.

_________________
Bob Rashkin
 



I am not going to wade thru your code.

The way that I would suggest that you CONSTRUCT you code is to lay out each control structure completely and THEN fill in with process code. For instance
Code:
   Do While [i]expression[/i]


      i = i + 1
   Loop
next
Code:
   Do While [i]expression[/i]
      If [i]expression[/i] Then

      Else

      End if

      i = i + 1
   Loop
and so on...

You have some MISSING part of a control structure, not necessarily "Do without loop"

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 

JohnJoker,

Do yourself a favor - align your code properly. You will see your problems a lot easier.

For example, this code of yours:
[tt]
If InStr(C1, CURCH) > 0 Then
ADNUM = "1"
Else
If InStr(C2, CURCH) > 0 Then
ADNUM = "2"
Else
If InStr(C3, CURCH) > 0 Then
ADNUM = "3"
Else
If InStr(C4, CURCH) > 0 Then
ADNUM = "4"
Else
If InStr(C5, CURCH) > 0 Then
ADNUM = "5"
Else
If InStr(C6, CURCH) > 0 Then
ADNUM = "6"
End If
End If
End If
End If
End If
End If[/tt]

Should look like this:
[tt]
If InStr(C1, CURCH) > 0 Then
ADNUM = "1"
Else
If InStr(C2, CURCH) > 0 Then
ADNUM = "2"
Else
If InStr(C3, CURCH) > 0 Then
ADNUM = "3"
Else
If InStr(C4, CURCH) > 0 Then
ADNUM = "4"
Else
If InStr(C5, CURCH) > 0 Then
ADNUM = "5"
Else
If InStr(C6, CURCH) > 0 Then
ADNUM = "6"
End If
End If
End If
End If
End If
End If[/tt]

Have fun.

---- Andy
 
And if you are nesting that many IF...THEN...ELSE statements you are almost certainly better off using SELECT...CASE.
 

mintjulep,

I did try to convert those nested IF statements into one SELECT CASE statement, but I failed. :-(

How would you do it?

Have fun.

---- Andy
 
How would you do it?
Select Case True
Case InStr(C1, CURCH) > 0
ADNUM = "1"
Case InStr(C2, CURCH) > 0
ADNUM = "2"
...
End Select

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Oh, you want me to actually look at the OP's code? [censored]

Ok, looking at it I'm wondering why the Elses are needed.

Doesn't this do the same??

Code:
If InStr(C1, CURCH) > 0 Then

If InStr(C2, CURCH) > 0 Then ADNUM = 1

If InStr(C3, CURCH) > 0 Then ADNUM = 2

If InStr(C4, CURCH) > 0 then  ADNUM = 3

If InStr(C5, CURCH) > 0 Then ADNUM = = 5

If InStr(C6, CURCH) > 0 Then ADNUM = 6

 
Doesn't this do the same
NO

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
I meant

Code:
If InStr(C1, CURCH) > 0 Then ADNUM = 1

If InStr(C2, CURCH) > 0 Then ADNUM = 2

If InStr(C3, CURCH) > 0 Then ADNUM = 3

If InStr(C4, CURCH) > 0 then  ADNUM = 4

If InStr(C5, CURCH) > 0 Then ADNUM = 5

If InStr(C6, CURCH) > 0 Then ADNUM = 6

Ok, logically it's different. But (assuming that only one of the things you're looking for exist) functionally it's the same.

Neither solution is sufficiently robust to check for more than one code.

A more robust solution might be something like:

Code:
If InStr(C1, CURCH) > 0 Then C1found = 100000

If InStr(C2, CURCH) > 0 Then C2found = 10000

If InStr(C3, CURCH) > 0 Then C3found = 1000

If InStr(C4, CURCH) > 0 then  C4found = 100

If InStr(C5, CURCH) > 0 Then C5found = 10

If InStr(C6, CURCH) > 0 Then C6found = 1

WhatFound = C1found + C2found + C3found + C4found + C5found + C6found

Select WhatFound

Case 111111
  debug.print("All Codes Found")
Case 101111
  debug.print("C1, C3, C4, C5, C6 Found")
Case 110111
  debug.print("C1, C2, C4, C5, C6 Found")

etc. for all permutations

Case 100000
  ADNUM = 1
Case 10000
  ADNUM = 2
CASE 1000
  ADNUM = 3
Case 100
  ADNUM = 4
Case 10
  ADNUM = 5
Case 1
  ADNUM = 6
End Select
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top