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
This is because the value generated here cannot be a long, that is why the CharPos was allowed to default to Variant
Brian
The giveaway was the xlErrValue syntax. That's why I questioned it. VBA in Excel can be different from Access in many ways
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.
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
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'
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
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
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 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
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
what do you mean? as oppossed to ""? or?One question tho' why are you wrapping the numbers in ' '
why a starting and ending ' in the IN brackets, sorry thats 2 questions.
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
Just ask those nice people at Microsoft to change the Excel specificationthis 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![]()
this is amazing, one small problem. Excell's cell only holds a certain amoung of characters. any ideas to get around that?