Find the position of the Nth occurence in a string

This is because the value generated here cannot be a long, that is why the CharPos was allowed to default to Variant

Brian

you, guys, are amazing, I feel so dumb every time I come here)))))))))))))))) in a good way
 
The giveaway was the xlErrValue syntax. That's why I questioned it. VBA in Excel can be different from Access in many ways

Yeah that puzzled me but as it hadn't been questioned by more knowledgeable folks I just assumed my ignorance.

Brian
 
Can you elaborate a bit more on what you are trying to do?

Are you trying to build some sql for an In() command?
 
Yes, that's what I'm trying to do. I need to be able to pull results for IDs that people give me and it can be any number of entries, 10000, 5000. I couldn't think of anything but to break it up by 1000.
 
Lets take a step back and work with actual examples. Pretend that the user has asked you for some data (normally with lots of numbers) but in this instance they are only asking for say 5. Give use what they request and ideally what your resulting syntax would be.
 
My old brain is starting to hurt now but before I go I will say one thing, you do not want to error in the code just because you do not find the nth 1000 position. By that I mean if you have found say 4000 IDs and are now looking for the 5000 and there are only 4001 then you need to know that to get the last Id.

Brian
 
My brain is the same Brian I am sat here listening to Children in Need drinking Southern Comfort and trwaling the forum. At present SuBo is singing Perfect Day. I wish it was.
 
My brain is the same Brian I am sat here listening to Children in Need drinking Southern Comfort and trwaling the forum. At present SuBo is singing Perfect Day. I wish it was.

I thought men weren't supposed to be able to multi task, heck that's 3.

Having just drained my glass of wine, and the bottle is empty, its time to go.

Brian
 
ok, i'm ready, please no laughing too loud

here's my code, i'm not creating the query here, just testing, meaning, there's no ODBC connection, just the query code in the debug window


ok, i get a request, it's an excel file with a row of IDs
24352
24353
25546
26354
288857


here's what i have so far


Code:
Dim NoOfRows As Long
Dim RepeatTimes As Long

NoOfRows = StringCountOccurrences(Forms!FDlgCreateTables!Criteria1, ",")

If (Int(NoOfRows / 998) * 998 = NoOfRows) Then
RepeatTimes = Int(NoOfRows / 998)
Else
RepeatTimes = Int(NoOfRows / 998) + 1
End If






Dim StartAt As Long
Dim StartingChar As Long
Dim EndingChar As Integer
Dim MidLength As Long
Dim Sets As Long
Dim NewString As String

    NewString = Forms!FDlgCreateTables!Criteria1 & ","
    Sets = 998
    EndingChar = CharPos(NewString, ",", Sets)




    For StartAt = 1 To RepeatTimes



    Dim CriteriaPart As String
    
    If CriteriaPart = "" Then
    CriteriaPart = "(p.OTHERID IN ('" & Replace(Left(NewString, EndingChar), ",", "','") & "'))"
    Else
    CriteriaPart = CriteriaPart & " or (p.OTHERID IN ('" & Replace(Left(NewString, EndingChar), ",", "','") & "'))"
    End If


    'Sets = Sets + 998
    StartingChar = EndingChar + 3
    NewString = Mid(NewString, EndingChar) & ","
    If StartAt = RepeatTimes Then
    EndingChar = InStrRev(NewString, ",")
    Else
    EndingChar = CharPos(NewString, ",", Sets) - 1
    End If
    MidLength = EndingChar - StartingChar
    
    Next StartAt
    
    

Dim tst As String
tst = "CREATE TABLE TMP_IDs AS " & vbCrLf & _
"SELECT DISTINCT p.OTHERID, p.PROVIDERID, o.LOCATIONID, o.OFFICEID, c.MPICONTRACTID GROUPNUMBER " & vbCrLf & _
"FROM mpi_provider.officecontract@ARCHIVE oc, mpi_provider.mpilocation@ARCHIVE l, mpi_provider.office@ARCHIVE o, mpi_provider.mpicontractprovider@ARCHIVE cp, " & vbCrLf & _
"mpi_provider.mpiprovider@ARCHIVE p, mpi_provider.mpinetworkprovider@ARCHIVE np, mpi_provider.mpicontract@ARCHIVE c " & vbCrLf & _
"WHERE p.providerid = cp.providerid AND cp.mpicontractid = oc.mpicontractid AND oc.officeid = o.officeid " & vbCrLf & _
"AND p.providerid = o.providerid AND o.locationid = l.locationid AND p.providerid = np.providerid AND cp.mpicontractid = c.mpicontractid " & vbCrLf & _
"AND SYSDATE BETWEEN c.effectivedate AND c.providertermdate AND SYSDATE BETWEEN np.effectivedate AND np.terminationdate " & vbCrLf & _
"AND SYSDATE BETWEEN cp.effectivedate AND cp.terminationdate AND SYSDATE BETWEEN oc.effectivedate AND oc.terminationdate " & vbCrLf & _
"AND SYSDATE BETWEEN o.serviceeffectivedate AND o.serviceterminationdate " & vbCrLf & _
"AND (" & CriteriaPart & ") " & vbCrLf & _
"AND np.mpinetworkcode IN ('PHCS', 'MPI') AND p.providertypecode = 'PROF' "

Debug.Print tst


and Brian, yes, that's exactly where i'm stuck, on the last iteration where it's less than 998
it goes fine to the last one and then highlights ELSE CRITERIAPART

and one last thing, i know that it's not perfect, meaning, it starts each sequence in the middle of the number, not at the comma, but that's ok, that i will fix myself, don't waste time on that

and thank you all!!!!!!!!!!!!!!
 
one more thing, before i start my program i convert the Excel row to look like this

2435,3554,6665,7776. i do that by hand while testing, but i might write the code to do it if i get everything else to work
 
oh my, i think i got it


If StartAt = RepeatTimes-1 Then
EndingChar = InStrRev(NewString, ",")
Else
EndingChar = CharPos(NewString, ",", Sets) - 1
End If
 
ok, another problem, do you see what it's doing?

Code:
CREATE TABLE TMP_IDs AS 
SELECT DISTINCT p.OTHERID, p.PROVIDERID, o.LOCATIONID, o.OFFICEID, c.MPICONTRACTID GROUPNUMBER 
FROM mpi_provider.officecontract@ARCHIVE oc, mpi_provider.mpilocation@ARCHIVE l, mpi_provider.office@ARCHIVE o, mpi_provider.mpicontractprovider@ARCHIVE cp, 
mpi_provider.mpiprovider@ARCHIVE p, mpi_provider.mpinetworkprovider@ARCHIVE np, mpi_provider.mpicontract@ARCHIVE c 
WHERE p.providerid = cp.providerid AND cp.mpicontractid = oc.mpicontractid AND oc.officeid = o.officeid 
AND p.providerid = o.providerid AND o.locationid = l.locationid AND p.providerid = np.providerid AND cp.mpicontractid = c.mpicontractid 
AND SYSDATE BETWEEN c.effectivedate AND c.providertermdate AND SYSDATE BETWEEN np.effectivedate AND np.terminationdate 
AND SYSDATE BETWEEN cp.effectivedate AND cp.terminationdate AND SYSDATE BETWEEN oc.effectivedate AND oc.terminationdate 
AND SYSDATE BETWEEN o.serviceeffectivedate AND o.serviceterminationdate 
AND ((p.OTHERID IN ('2151','2152','2153','9201','9214','9216','9222','13741','15004','15006','')) or 
(p.OTHERID IN ('','15387','19220','19223','19225','19230','19257','19259','19266','19270','20172','20176','20177','')) or 
(p.OTHERID IN ('','20529','20531','20532','20533','20535','20536','22437','22438','22439','22440','22441','22442','22443','22444','22578','')) or 
(p.OTHERID IN ('','25111','25114','25115','25116','25117','')) or 
(p.OTHERID IN ('','26540','26572','26640','26641','26643','26644','26645','26646','26647','26648','26649','26651','26654','26656','26657','26658','26660','26692','26693','')) or 
(p.OTHERID IN ('','26694','26695','26696','26697','26698','26699','29117','29119','29121','29122','')) or 
(p.OTHERID IN ('','29123','29125','29126','29127','29129','29130','102170','102171','102172',''))) 
AND np.mpinetworkcode IN ('PHCS', 'MPI') AND p.providertypecode = 'PROF'

i cut out a bunch of numbers, it's 999 on each iteration, so that part is right, but starting on the 2nd iteration i start getting '', at the beginning and on all of them i have ,'' at the end



here's the updated code

Code:
Dim NoOfRows As Long
Dim RepeatTimes As Long

NoOfRows = StringCountOccurrences(Forms!FDlgCreateTables!Criteria1, ",")

If (Int(NoOfRows / 998) * 998 = NoOfRows) Then
RepeatTimes = Int(NoOfRows / 998)
Else
RepeatTimes = Int(NoOfRows / 998) + 1
End If






Dim StartAt As Long
Dim StartingChar As Long
Dim EndingChar As Integer
Dim MidLength As Long
Dim Sets As Long
Dim NewString As String

    NewString = Forms!FDlgCreateTables!Criteria1
    EndingChar = CharPos(NewString, ",", 998) - 1




    For StartAt = 1 To RepeatTimes



    Dim CriteriaPart As String
    
    If CriteriaPart = "" Then
    CriteriaPart = "(p.OTHERID IN ('" & Replace(Left(NewString, EndingChar), ",", "','") & "'))"
    Else
    CriteriaPart = CriteriaPart & " or " & vbCrLf & _
    "(p.OTHERID IN ('" & Replace(Left(NewString, EndingChar), ",", "','") & "'))"
    End If


    StartingChar = EndingChar + 1
    NewString = Mid(NewString, EndingChar)
    If StartAt = RepeatTimes - 1 Then
    EndingChar = InStrRev(NewString, ",")
    Else
    EndingChar = CharPos(NewString, ",", 998)
    End If
    MidLength = EndingChar - StartingChar
    
    Next StartAt
    
    

Dim tst As String
tst = "CREATE TABLE TMP_IDs AS " & vbCrLf & _
"SELECT DISTINCT p.OTHERID, p.PROVIDERID, o.LOCATIONID, o.OFFICEID, c.MPICONTRACTID GROUPNUMBER " & vbCrLf & _
"FROM mpi_provider.officecontract@ARCHIVE oc, mpi_provider.mpilocation@ARCHIVE l, mpi_provider.office@ARCHIVE o, mpi_provider.mpicontractprovider@ARCHIVE cp, " & vbCrLf & _
"mpi_provider.mpiprovider@ARCHIVE p, mpi_provider.mpinetworkprovider@ARCHIVE np, mpi_provider.mpicontract@ARCHIVE c " & vbCrLf & _
"WHERE p.providerid = cp.providerid AND cp.mpicontractid = oc.mpicontractid AND oc.officeid = o.officeid " & vbCrLf & _
"AND p.providerid = o.providerid AND o.locationid = l.locationid AND p.providerid = np.providerid AND cp.mpicontractid = c.mpicontractid " & vbCrLf & _
"AND SYSDATE BETWEEN c.effectivedate AND c.providertermdate AND SYSDATE BETWEEN np.effectivedate AND np.terminationdate " & vbCrLf & _
"AND SYSDATE BETWEEN cp.effectivedate AND cp.terminationdate AND SYSDATE BETWEEN oc.effectivedate AND oc.terminationdate " & vbCrLf & _
"AND SYSDATE BETWEEN o.serviceeffectivedate AND o.serviceterminationdate " & vbCrLf & _
"AND (" & CriteriaPart & ") " & vbCrLf & _
"AND np.mpinetworkcode IN ('PHCS', 'MPI') AND p.providertypecode = 'PROF' "

'MsgBox tst
Debug.Print tst
 
Why do posters, not just lala, post code without the sub or function statements?
And if we are to aid in debugging a db with some test data would be nice.

One question tho' why are you wrapping the numbers in ' ', why a starting and ending ' in the IN brackets, sorry thats 2 questions.

I also suspect that you are not adjusting the starting and end character positions to remove the , as nescessary.

As for handling the last lot of numbers I would change the Charpos code to

Code:
Public Function CharPos(SearchString As String, Char As String, Instance As Long) as Long
     
    Dim x As Integer, n As Long
    Lastrowflag = False 
    For x = 1 To Len(SearchString)
        CharPos = CharPos + 1
         
         If Mid(SearchString, x, Len(Char)) = Char Then n = n + 1
         
        If n = Instance Then Exit Function
    Next x
     
       Lastrowflag = True
 
End Function

Lastrowflag would be declared as public in my Globals module. It could then be tested for later and the lastrow handled as required, it might also be the first row of course.

Brian
 
You said earlier that you were converting your Excel column of numbers to the list manually

ie
24352
24353
25546
26354
288857
to
24352,24353,25546,26354,288857

if that is correct then a simple bit of code will put it into a single cell which could be copied.
Code:
Sub copycolumntocell()
Dim lastrow As Long
lastrow = Sheets("sheet1").Range("A65536").End(xlUp).Row

For r = 1 To lastrow - 1
Sheets("sheet2").Range("A1") = Sheets("sheet2").Range("A1") & Sheets("Sheet1").Cells(r, 1) & ","

Next r

Sheets("sheet2").Range("A1") = Sheets("sheet2").Range("A1") & Sheets("Sheet1").Cells(lastrow, 1)

End Sub

You could even put your ' ' in


Brian
 
You said earlier that you were converting your Excel column of numbers to the list manually

ie
24352
24353
25546
26354
288857
to
24352,24353,25546,26354,288857

if that is correct then a simple bit of code will put it into a single cell which could be copied.
Code:
Sub copycolumntocell()
Dim lastrow As Long
lastrow = Sheets("sheet1").Range("A65536").End(xlUp).Row

For r = 1 To lastrow - 1
Sheets("sheet2").Range("A1") = Sheets("sheet2").Range("A1") & Sheets("Sheet1").Cells(r, 1) & ","

Next r

Sheets("sheet2").Range("A1") = Sheets("sheet2").Range("A1") & Sheets("Sheet1").Cells(lastrow, 1)

End Sub

You could even put your ' ' in


Brian

thank you so much for this one, i put the 's around numbers in Access, but everything else I had no idea how to start on.
I thought of writing a macro in Word because that's what i use to do it by hand (replace)
thank you, i do this a lot, this is perfect!!!!!!!!!!!!
 
Why do posters, not just lala, post code without the sub or function statements?
And if we are to aid in debugging a db with some test data would be nice.

One question tho' why are you wrapping the numbers in ' ', why a starting and ending ' in the IN brackets, sorry thats 2 questions.

I also suspect that you are not adjusting the starting and end character positions to remove the , as nescessary.

As for handling the last lot of numbers I would change the Charpos code to

Code:
Public Function CharPos(SearchString As String, Char As String, Instance As Long) as Long
     
    Dim x As Integer, n As Long
    Lastrowflag = False 
    For x = 1 To Len(SearchString)
        CharPos = CharPos + 1
         
         If Mid(SearchString, x, Len(Char)) = Char Then n = n + 1
         
        If n = Instance Then Exit Function
    Next x
     
       Lastrowflag = True
 
End Function

Lastrowflag would be declared as public in my Globals module. It could then be tested for later and the lastrow handled as required, it might also be the first row of course.

Brian

i don't know)))))))))))) but I will definitely do it from now on, didn't realize it's annoying
and sorry, i got this to work, didn't post back because noone replied so I thought noone would care, again, my fault

and you're right, it was because i wasn't adjusting the start and end character
and I will fix the code with your suggestion

One question tho' why are you wrapping the numbers in ' '
what do you mean? as oppossed to ""? or?

why a starting and ending ' in the IN brackets, sorry thats 2 questions.

that was my problem, fixed now
 
You said earlier that you were converting your Excel column of numbers to the list manually

ie
24352
24353
25546
26354
288857
to
24352,24353,25546,26354,288857

if that is correct then a simple bit of code will put it into a single cell which could be copied.
Code:
Sub copycolumntocell()
Dim lastrow As Long
lastrow = Sheets("sheet1").Range("A65536").End(xlUp).Row

For r = 1 To lastrow - 1
Sheets("sheet2").Range("A1") = Sheets("sheet2").Range("A1") & Sheets("Sheet1").Cells(r, 1) & ","

Next r

Sheets("sheet2").Range("A1") = Sheets("sheet2").Range("A1") & Sheets("Sheet1").Cells(lastrow, 1)

End Sub

You could even put your ' ' in


Brian

this is amazing, one small problem. Excell's cell only holds a certain amoung of characters. any ideas to get around that?
 
this is amazing, one small problem. Excell's cell only holds a certain amoung of characters. any ideas to get around that?
Just ask those nice people at Microsoft to change the Excel specification:rolleyes:
 
Just ask those nice people at Microsoft to change the Excel specification:rolleyes:

)))))))))))))))))))))))) i like MS, i know i'm about to have rotten tomatoes thrown at me
MS Office is amazing, Access especially and the ability to use VBA with Office. it's very thought out, powerful, Windows too
i don't have anything to compare with, that's all i ever used, but that's mostly because I never had the need to, MS does all i need
 
this is amazing, one small problem. Excell's cell only holds a certain amoung of characters. any ideas to get around that?

Not offhand , I had I think 56000 characters in my test, no idea what the max is, must try to find out.
I would guess that it is possible to write directly to WORD but have never done it. I wonder if you could put a simple count in and after a certain number of cells, maybe even characters with a bit of thought, switch the receiving cell. Would that help?
I'll have to give that a go.

The issue of the 's is that in a query testing for numbers you would code
IN(1,1234,12345) no 's, 's make them text I think anyway it gives a data mismatch error.

Brian
 

Users who are viewing this thread

Back
Top Bottom