Showing posts with label Tech. Show all posts
Showing posts with label Tech. Show all posts

### Hexadecimal Base 16 to Decimal Base 10 – How to Do / Convert Base 16 to / from Base 10 – Number System Conversions – Includes Examples

Latest update: June 9, 2024

Hex: 0-9, A a, B b, C c, D d, E e, F f
 How to Do Hexadecimal, Base 16 Number System Conversions. Includes Examples.

Hexadecimal (base 16) is the primary base numbering system used by computer programmers. Hex code is used in everything from core dumps to color codes and everything in-between.

Per the introduction, base 10 has ten numbers (0-9) and orders of magnitude that are times ten. The orders of magnitude are l, 10, 100 (10x10) , 1000 (10x10x10), etc.

An example would be the number 5681. This number means there are:
• one 1’s,
• eight 10’s,
• six 100’s,
• and five 1000’s.
Which represents 1 + 80 + 600 + 5000; for a total of 5681.

Base 16 uses the same base 10 structure, the only difference being the orders of magnitude.

### How to Do the Hexadecimal Base 16 Numbering System

 Beware Miscalculations
The orders of magnitude are times sixteen. The lowest-order number represents itself times one. The next-order number represents itself times sixteen. The next order number represents itself times 16x16 or itself times 256. The next order number represents itself times 16x16x16 or itself times 4096. And so on.

#### Hexadecimal Orders of Magnitude:

1 · 16 · 256 · 4096 · 65536 · 1048576

#### Positional:

1048576 · 65536 · 4096 · 256 · 16 · 1

Base 16 aka hex has sixteen numbers (0-F). The first ten numbers are the usual 0 thru 9. The next six numbers are A=10, B=11, C=12, D=13, E=14, F=15.

Altogether we have:
0=0, 1=1, 2=2, 3=3, 4=4, 5=5, 6=6, 7=7, 8=8, 9=9,
A=10, B=11, C=12, D=13, E=14, F=15.

A basic, first example of a hexadecimal number would be the base 16 number 11111. This would mean there is:
• one 1,
• one 16,
• one 256,
• one 4096,
• and one 65536.
Which represents 1 + 16 + 256 + 4096 + 65536; for a total of 69905 in Base 10 decimal.

Another base 16 example would be the hex number 5C7F. This number means there are:
• fifteen 1’s,
• seven 16’s,
• twelve 256’s,
• and five 4096’s.
Which represents 15 +112 +3072 + 20480; for a total of 23679 in decimal.

Another base 16 example would be the hex number D24A. This number means there are:
• ten 1’s,
• four 16’s,
• two 256’s,
• and thirteen 4096’s.
Which represents 10 +64 +512 + 53248; for a total of 53834 in decimal.

#### Hexadecimal Orders of Magnitude

1 · 16 · 256 · 4096 · 65536 · 1048576

#### Positional

1048576 · 65536 · 4096 · 256 · 16 · 1

### Table: Hexadecimal (Base 16) to Decimal (Base 10) Conversion Examples

Column headings in the following table are simply a convenience relist of the relevant positional orders of magnitude as applies to each column. There is no significance attached as to where one column ends and the next one begins.
A=10, B=11, C=12, D=13, E=14, F=15
 16 · 1 256 · 16 · 1 65536 · 4096 · 256 · 16 · 1 0=0 16=22 101=257 1=1 17=23 111=273 2=2 1A=26 200=512 9=9 1C=28 3E4=996 A=10 1F=31 3E8=1000 B=11 20=32 BAD=2989 F=15 21=33 FFF=4095 10=16 27=39 1000=4096 11=17 2A=42 1004=4100 12=18 77=119 2BAD=11181 13=19 BD=189 DEAD=57005 14=20 FF=255 10000=65536 15=21 100=256 10100=65792

### Simply a Sequential List of Hexadecimal Numbers

Table created using the Microsoft Excel formula: “=DEC2HEX(cell address here)”.

1 2 3 4 5 6 7 8 9 A B C D E F 10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F 20 21 22 23 24 25 26 27 28 29 2A 2B 2C 2D 2E 2F 30 31 32 33 34 35 36 37 38 39 3A 3B 3C 3D 3E 3F 40 41 42 43 44 45 46 47 48 49 4A 4B 4C 4D 4E 4F 50 51 52 53 54 55 56 57 58 59 5A 5B 5C 5D 5E 5F 60 61 62 63 64 65 66 67 68 69 6A 6B 6C 6D 6E 6F 70 71 72 73 74 75 76 77 78 79 7A 7B 7C 7D 7E 7F 80 81 82 83 84 85 86 87 88 89 8A 8B 8C 8D 8E 8F 90 91 92 93 94 95 96 97 98 99 9A 9B 9C 9D 9E 9F A0 A1 A2 A3 A4 A5 A6 A7 A8 A9 AA AB AC AD AE AF B0 B1 B2 B3 B4 B5 B6 B7 B8 B9 BA BB BC BD BE BF C0 C1 C2 C3 C4 C5 C6 C7 C8 C9 CA CB CC CD CE CF D0 D1 D2 D3 D4 D5 D6 D7 D8 D9 DA DB DC DD DE DF E0 E1 E2 E3 E4 E5 E6 E7 E8 E9 EA EB EC ED EE EF F0 F1 F2 F3 F4 F5 F6 F7 F8 F9 FA FB FC FD FE FF 100 101 102 103 104 105 106 107 108 109 10A 10B 10C 10D 10E 10F 110 111 112 113 114 115 116 117 118 119 11A 11B 11C 11D 11E 11F 120 121 122 123 124 125 126 127 128 129 12A 12B 12C 12D 12E 12F 130 131 132 133 134 135 136 137 138 139 13A 13B 13C 13D 13E 13F 140 141 142 143 144 145 146 147 148 149 14A 14B 14C 14D 14E 14F 150 151 152 153 154 155 156 157 158 159 15A 15B 15C 15D 15E 15F 160 161 162 163 164 165 166 167 168 169 16A 16B 16C 16D 16E 16F 170 171 172 173 174 175 176 177 178 179 17A 17B 17C 17D 17E 17F 180 181 182 183 184 185 186 187 188 189 18A 18B 18C 18D 18E 18F 190 191 192 193 194 195 196 197 198 199 19A 19B 19C 19D 19E 19F 1A0 1A1 1A2 1A3 1A4 1A5 1A6 1A7 1A8 1A9 1AA 1AB 1AC 1AD 1AE 1AF 1B0 1B1 1B2 1B3 1B4 1B5 1B6 1B7 1B8 1B9 1BA 1BB 1BC 1BD 1BE 1BF 1C0 1C1 1C2 1C3 1C4 1C5 1C6 1C7 1C8 1C9 1CA 1CB 1CC 1CD 1CE 1CF 1D0 1D1 1D2 1D3 1D4 1D5 1D6 1D7 1D8 1D9 1DA 1DB 1DC 1DD 1DE 1DF 1E0 1E1 1E2 1E3 1E4 1E5 1E6 1E7 1E8 1E9 1EA 1EB 1EC 1ED 1EE 1EF 1F0 1F1 1F2 1F3 1F4 1F5 1F6 1F7 1F8 1F9 1FA 1FB 1FC 1FD 1FE 1FF 200 201 202 203 204 205 206 207 208 209 20A 20B 20C 20D 20E 20F 210 211 212 213 214 215 216 217 218 219 21A 21B 21C 21D 21E 21F 220 221 222 223 224 225 226 227 228 229 22A 22B 22C 22D 22E 22F 230 231 232 233 234 235 236 237 238 239 23A 23B 23C 23D 23E 23F 240 241 242 243 244 245 246 247 248 249 24A 24B 24C 24D 24E 24F 250 251 252 253 254 255 256 257 258 259 25A 25B 25C 25D 25E 25F 260 261 262 263 264 265 266 267 268 269 26A 26B 26C 26D 26E 26F 270 271 272 273 274 275 276 277 278 279 27A 27B 27C 27D 27E 27F 280 281 282 283 284 285 286 287 288 289 28A 28B 28C 28D 28E 28F 290 291 292 293 294 295 296 297 298 299 29A 29B 29C 29D 29E 29F 2A0 2A1 2A2 2A3 2A4 2A5 2A6 2A7 2A8 2A9 2AA 2AB 2AC 2AD 2AE 2AF 2B0 2B1 2B2 2B3 2B4 2B5 2B6 2B7 2B8 2B9 2BA 2BB 2BC 2BD 2BE 2BF 2C0 2C1 2C2 2C3 2C4 2C5 2C6 2C7 2C8 2C9 2CA 2CB 2CC 2CD 2CE 2CF 2D0 2D1 2D2 2D3 2D4 2D5 2D6 2D7 2D8 2D9 2DA 2DB 2DC 2DD 2DE 2DF 2E0 2E1 2E2 2E3 2E4 2E5 2E6 2E7 2E8 2E9 2EA 2EB 2EC 2ED 2EE 2EF 2F0 2F1 2F2 2F3 2F4 2F5 2F6 2F7 2F8 2F9 2FA 2FB 2FC 2FD 2FE 2FF 300 301 302 303 304 305 306 307 308 309 30A 30B 30C 30D 30E 30F 310 311 312 313 314 315 316 317 318 319 31A 31B 31C 31D 31E 31F 320 321 322 323 324 325 326 327 328 329 32A 32B 32C 32D 32E 32F 330 331 332 333 334 335 336 337 338 339 33A 33B 33C 33D 33E 33F 340 341 342 343 344 345 346 347 348 349 34A 34B 34C 34D 34E 34F 350 351 352 353 354 355 356 357 358 359 35A 35B 35C 35D 35E 35F 360 361 362 363 364 365 366 367 368 369 36A 36B 36C 36D 36E 36F 370 371 372 373 374 375 376 377 378 379 37A 37B 37C 37D 37E 37F 380 381 382 383 384 385 386 387 388 389 38A 38B 38C 38D 38E 38F 390 391 392 393 394 395 396 397 398 399 39A 39B 39C 39D 39E 39F 3A0 3A1 3A2 3A3 3A4 3A5 3A6 3A7 3A8 3A9 3AA 3AB 3AC 3AD 3AE 3AF 3B0 3B1 3B2 3B3 3B4 3B5 3B6 3B7 3B8 3B9 3BA 3BB 3BC 3BD 3BE 3BF 3C0 3C1 3C2 3C3 3C4 3C5 3C6 3C7 3C8 3C9 3CA 3CB 3CC 3CD 3CE 3CF 3D0 3D1 3D2 3D3 3D4 3D5 3D6 3D7 3D8 3D9 3DA 3DB 3DC 3DD 3DE 3DF 3E0 3E1 3E2 3E3 3E4 3E5 3E6 3E7 3E8 3E9 3EA 3EB 3EC 3ED 3EE 3EF 3F0 3F1 3F2 3F3 3F4 3F5 3F6 3F7 3F8 3F9 3FA 3FB 3FC 3FD 3FE 3FF 400 401 402 403 404 405 406 407 408 409 40A 40B 40C 40D 40E 40F 410 411 412 413 414 415 416 417 418 419 41A 41B 41C 41D 41E 41F 420 421 422 423 424 425 426 427 428 429 42A 42B 42C 42D 42E 42F 430 431 432 433 434 435 436 437 438 439 43A 43B 43C 43D 43E 43F 440 441 442 443 444 445 446 447 448 449 44A 44B 44C 44D 44E 44F 450 451 452 453 454 455 456 457 458 459 45A 45B 45C 45D 45E 45F 460 461 462 463 464 465 466 467 468 469 46A 46B 46C 46D 46E 46F 470 471 472 473 474 475 476 477 478 479 47A 47B 47C 47D 47E 47F 480 481 482 483 484 485 486 487 488 489 48A 48B 48C 48D 48E 48F 490 491 492 493 494 495 496 497 498 499 49A 49B 49C 49D 49E 49F 4A0 4A1 4A2 4A3 4A4 4A5 4A6 4A7 4A8 4A9 4AA 4AB 4AC 4AD 4AE 4AF 4B0 4B1 4B2 4B3 4B4 4B5 4B6 4B7 4B8 4B9 4BA 4BB 4BC 4BD 4BE 4BF 4C0 4C1 4C2 4C3 4C4 4C5 4C6 4C7 4C8 4C9 4CA 4CB 4CC 4CD 4CE 4CF 4D0 4D1 4D2 4D3 4D4 4D5 4D6 4D7 4D8 4D9 4DA 4DB 4DC 4DD 4DE 4DF 4E0 4E1 4E2 4E3 4E4 4E5 4E6 4E7 4E8 4E9 4EA 4EB 4EC 4ED 4EE 4EF 4F0 4F1 4F2 4F3 4F4 4F5 4F6 4F7 4F8 4F9 4FA 4FB 4FC 4FD 4FE 4FF 500 501 502 503 504 505 506 507 508 509 50A 50B 50C 50D 50E 50F 510 511 512 513 514 515 516 517 518 519 51A 51B 51C 51D 51E 51F 520 521 522 523 524 525 526 527 528 529 52A 52B 52C 52D 52E 52F 530 531 532 533 534 535 536 537 538 539 53A 53B 53C 53D 53E 53F 540 541 542 543 544 545 546 547 548 549 54A 54B 54C 54D 54E 54F 550 551 552 553 554 555 556 557 558 559 55A 55B 55C 55D 55E 55F 560

- End of Article -

### Free Visual Basic 6 Source Code Applications Examples for VB6 and SQL Programming - Both for the Beginner and Advanced

Latest update: June 10, 2024. Page URL indicates original publication date; meanwhile, times change and the updates continue.

The author of this page has worked in the tech, software industry as a programmer/analyst for over 20 years. There's a lot of code here, both for beginners and advanced; file will take a awhile to load.

Apparently, VB is finally dead. The older posts follow. Conflicting comments are appreciated.

[Just a pandemic side note. Government agencies are desperate for anyone who has ever programmed in COBOL; they don't care if you are retired or what age you are.]

Surprisingly, employment opportunities still abound for Visual Basic 6.0. A simple search for "VB6" at a job search aggregation site still brings up lots of them.

### About The VB6 and SQL Programming Code Libraries

This extensive page contains debugged MS Visual Basic 6.0 ( VB6 ) source code examples from business applications I have written over the years. You will find standalone blocks of SQL, record set processing, data manipulation (field and character level), and some useful GUI routines. Other items include:
• All sorts of string functions
• All sorts of while loops
• Shell command
• All sorts of date format and other date functions
• Message box, msgbox
• Printing
• File exists
• Call command
• Execute
• Records delete command
• Queries
• Select records
• Select variables
• Creating and chaining together subroutines
• And more
An alternative title for this page might be SQL Source Code Examples. VB6's ability to integrate SQL is one of its major strengths. There is also VBA relevancy.

You will notice occasional code snippets that have been commented, purpose being to temporarily hide them from from the compiler for whatever reason. Even though temporarily commented, the snippets are also production, debugged code.

This page has over 13,000 words of VB6 and SQL source code snippets, examples, samples, etc. A lot of the syntax remains eternal in the land of Visual Basic. Hopefully these code libraries will serve people well for many years.

If looking for a particular command, syntax, etc.; the F3 or Ctrl-F browser search function will come in mighty handy.

May all your programming adventures be prosperous ones.

## Visual Basic 6.0 and SQL Code Examples Library One - Beginner and Advanced

VB6 - Visual Basic 6.0

'TO RUN WORD OR ANY OTHER SOFTWARE FROM WITHIN A VISUAL BASIC APPLICATION.

Private Sub cmdDocumentation_Click()
Dim RetVal
RetVal = Shell("C:\Program Files\Microsoft Office\Office\WINWORD.EXE XYZ.DOC", 1)
End Sub

Private Sub cmdDBpicture_Click()
frmDBpicture.Show 1
End Sub

Private Sub cmdTechDoc_Click()
Dim RetVal
RetVal = Shell("C:\Program Files\Microsoft Office\Office\WINWORD.EXE XYZtech.DOC", 1)
End Sub

Private Sub cmdUserDoc_Click()
Dim RetVal
RetVal = Shell("C:\Program Files\Microsoft Office\Office\WINWORD.EXE XYZuser.DOC", 1)
End Sub

VB6 - Visual Basic

'OBTAINING USER DATE RANGE and
'DATE MANIPULATION CODE

'frmDATERANGE screen
'Notes:
'   Variables declared as public in Module1
'   Public procedures can be found in Module1

varSTARTDATE = Format(Date, "mm/01/yy")
varENDDATE = DateAdd("d", -1, DateAdd("m", 1, varSTARTDATE))

txtSTARTDATE.Text = varSTARTDATE
txtENDDATE.Text = varENDDATE

End Sub

Private Sub cmdMONTH_Click(Index As Integer)

varSTARTDATE = CDate(Trim(Str(Index)) + "/01/" + Format(Date, "yy"))
varENDDATE = CDate(DateAdd("d", -1, DateAdd("m", 1, varSTARTDATE)))

txtSTARTDATE.Text = varSTARTDATE 'global
txtENDDATE.Text = varENDDATE 'global

End Sub

Private Sub cmdProceed_Click()

varDR = True

varSTARTDATE = CStr(txtSTARTDATE.Text)
varENDDATE = CStr(txtENDDATE.Text)

varPROCEED = True
varCANCEL = False

Me.Hide

End Sub

Private Sub cmdCancel_Click()

varDR = False
varPROCEED = False
varCANCEL = True

End Sub

VB6 - SQL

Private Sub cmdPrintReport_Click()
'CREATE DATA AND PRINT REPORT USING A SPECIFIED DATE RANGE

Dim dbs As Database
Dim strSQL As String
Dim TheSelectedMonth As String

'FIRST WE DETERMINE WHAT DATE RANGE THE USER WANTS
varCANCEL = False
frmDATERANGE.Show 1
Me.Refresh

If varCANCEL Then Exit Sub

supervarS = CStr(varSTARTDATE)
supervarE = CStr(varENDDATE)

Set dbs = OpenDatabase(gsDatabase)

'NEXT WE SELECT OUT THOSE RECORDS FROM THE RELEVANT TABLE
'TABLES TEMP X,Y,Z ARE INTERMEDIATE STEP TABLES THE USER CAN VIEW
On Error Resume Next
dbs.Execute "DROP TABLE [TEMPX];"
Err.Clear
strSQL = "SELECT ACCOUNTNOFLD, DATEFLD INTO TEMPX " _
& "From THETABLE WHERE " _
& "(((THETABLE.DATEFLD)>=#" & supervarS & "#)) AND " _
& "(((THETABLE.DATEFLD)<=#" & supervarE & "#)) AND " _
& "(THETABLE.ANOTHERFLD) ='N';"
dbs.Execute (strSQL)

'THEN WE GET MORE DATA FROM ANOTHER TABLE
'BY USING THE IN-COMMON ACCOUNTNOFLD USING JOIN
On Error Resume Next
dbs.Execute "DROP TABLE [TEMPY];"
Err.Clear
strSQL = "SELECT * INTO TEMPY " _
& "From ANOTHERTBL INNER JOIN TEMPX ON " _
& "ANOTHERTBL.ACCOUNTNOFLD=TEMPX.ACCOUNTNOFLD;"
dbs.Execute (strSQL)

'NEXT WE ADD SOME NEW FIELDS
dbs.Execute ("ALTER TABLE TEMPY ADD COLUMN CUSTSUBSETFLD text")
dbs.Execute ("ALTER TABLE TEMPY ADD COLUMN ORDERSUBSETFLD text")

dbs.Close

'THEN POPULATE FIELDS WITH CUSTSUBSETFLD AND ORDERSUBSETFLD DATA
Set dbs = OpenDatabase(gsDatabase)
Set rstTEMPY = dbs.OpenRecordset("TEMPY")

Me.Refresh
Counter = 1
With rstTEMPY
.MoveFirst
While Not .EOF
.Edit
If Not IsNull(.THELARGERFLD) Then
.CUSTSUBSETFLD = CStr(Mid(.THELARGERFLD, 1, 11))
.ORDERSUBSETFLD = CStr(Mid(.THELARGERFLD, 15, 20))
Else
.CUSTSUBSETFLD = "None"
.ORDERSUBSETFLD = "None"
End If
.Update
Counter = Counter + 1
Debug.Print CStr(Counter)
.MoveNext
Wend
End With

rstTEMPY.Close

'INDEX TABLES SO CRYSTAL REPORTS WILL WORK
dbs.Execute "CREATE INDEX NewIndexX ON TEMPX (ACCOUNTNOFLD);"
dbs.Execute "CREATE INDEX NewIndexY ON TEMPY (ACCOUNTNOFLD);"

dbs.Close
Set rstTEMPY = Nothing
Set dbs = Nothing

'DEFINE REPORT
CR1.ReportFileName = "THEREPORT.rpt"

'PUT REPORT TITLE AND MONTH IN FORMULA FOR CRYSTAL REPORTS TO USE.
'CR1.Formulas(0) = "USERMONTH= " _
& "'" & theCurrentMonth & "'"

'RUN REPORT
CR1.Action = 1

Close
Set dbs = Nothing
End Sub 'END OF CREATE DATA AND PRINT REPORT USING A SPECIFIED DATE RANGE

VB6 - SQL

Private Sub cmdAnotherRpt_Click()

Dim dbs As Database
Dim strSQL As String
Dim TheSelectedMonth As String

varCANCEL = False
frmDATERANGE.Show 1
Me.Refresh

If varCANCEL Then Exit Sub

theCurrentMonth = "Blah Blah Report for " _
& CStr(Format(varENDDATE, "mmmm"))
thePrevMonthX = DateAdd("m", -1, varENDDATE)
ThePrevMonth = CStr(UCase(CStr(Format(thePrevMonthX, "mmm"))))

Set dbs = OpenDatabase(gsDatabase)

On Error Resume Next
dbs.Execute "DROP TABLE [TEMPX];"
Err.Clear

'Gets the code 2 data WITH THE APPROPRIATE MONTH FIELD
strSQL = "SELECT FLDA, FLDB, FLDC, FLDD, " _
& ThePrevMonth _
& " INTO TEMPX From SOURCETABLE " _
& "WHERE CODE = '2' AND OTHERFLD = 'Y';"
dbs.Execute (strSQL)

'create new field for the standard report
dbs.Execute ("ALTER TABLE Tempx ADD COLUMN PrevMonth integer")

'move thePrevMonth to new PrevMonth field
strSQL = "UPDATE TEMPX " _
& "SET PREVMONTH = " _
& ThePrevMonth _
& ";"
dbs.Execute (strSQL)

'PUT NAME OF MONTH IN TABLE FOR CRYSTAL REPORTS TO USE.

CR1.ReportFileName = "THEREPORT.rpt"
CR1.Formulas(0) = "USERMONTH= " _
& "'" & theCurrentMonth & "'"
CR1.Action = 1

Close
Set dbs = Nothing

End Sub 'end of cmdAnotherRpt button

VB6 - SQL

Private Sub cmdMonthEndDetailRpt_Click()
'DETAIL REPORT USING MULTIPLE TABLES

Dim dbs As Database
Dim strSQL As String
Dim TheSelectedMonth As String

varCANCEL = False
frmDATERANGE.Show 1
Me.Refresh

If varCANCEL Then Exit Sub

theCurrentMonth = "Month End Detail Report for " _
& CStr(Format(varENDDATE, "mmmm"))
thePrevMonthX = DateAdd("m", -1, varENDDATE)
ThePrevMonth = CStr(UCase(CStr(Format(thePrevMonthX, "mmm"))))

Set dbs = OpenDatabase(gsDatabase)

On Error Resume Next
dbs.Execute "DROP TABLE [TEMPX];"
Err.Clear

'Gets INVENFILE data WITH THE APPROPRIATE MONTH FIELD
strSQL = "SELECT SKU, DESC, ISSUEUNIT, VENDOR, CURR_BAL, " _
& ThePrevMonth _
& " INTO TEMPX From INVENFILE;"
dbs.Execute (strSQL)

'create new field for the standard report
dbs.Execute ("ALTER TABLE Tempx ADD COLUMN PrevMonth integer")

'move thePrevMonth to new PrevMonth field
strSQL = "UPDATE TEMPX " _
& "SET PREVMONTH = " _
& ThePrevMonth _
& ";"
dbs.Execute (strSQL)

'WE'VE CREATED THE TEMPX TABLE THAT CONTAINS THE INVENTORYFILE DATA.
'NOW WE CREATE THE ASSOCIATED TRANSACTION DATA.

supervarS = CStr(varSTARTDATE)
supervarE = CStr(varENDDATE)

'WE SELECT OUT THE MTD TRANSACTION RECORDS
On Error Resume Next
dbs.Execute "DROP TABLE [TEMPY];"
Err.Clear
strSQL = "SELECT SKU, TRANS_NUMBER, ORDERDATE, QTY, THETYPE, TRCODE INTO TEMPY " _
& "From TRANSACTION WHERE " _
& "(((TRANSACTION.ORDERDATE)>=#" & supervarS & "#)) AND " _
& "(((TRANSACTION.ORDERDATE)<=#" & supervarE & "#));"
dbs.Execute (strSQL)

'NOW WE PLOP IN THE REASON DESCRIPTIONS.

'create new field for the reason description.
dbs.Execute ("ALTER TABLE Tempy ADD COLUMN REASON text")

Set wrkJET = CreateWorkspace("", "admin", "", dbUseJet)
Set dbsCurrent = wrkJET.OpenDatabase(gsDatabase, True)
Set rstTEMPY = dbsCurrent.OpenRecordset("TEMPY")

Me.Refresh

With rstTEMPY

.MoveFirst

While Not .EOF

.Edit

Select Case .theTYPE  'Evaluate WMSCODE.

Case "A1"
.reason = "(+) Positive Adjustment"

Case "A2"
If .TRCODE = "62" Then .reason = "(-) Negative Adjustment"
If .TRCODE = "64" Then .reason = "(-) Broken/Damaged"
If .TRCODE = "61" Then .reason = "(-) Repackaging Adjustment"

Case "C1"
.reason = "(+) Customer Return"

Case "M2"
If .TRCODE = "82" Then .reason = "(-) Issue to Customer"
If .TRCODE = "80" Then .reason = "(-) Exception Order"

Case "P1"
.reason = "(+) Repack Finished Stock"

Case "P2"
.reason = "(-) Repack Bulk Stock"

Case "R1"
.reason = "(+) Receiving"

Case "R2"
.reason = "(-) Receiving Adjustment"

Case "V2"

Case "V1"
.reason = "(+) Exchange from Vendor"

Case Else
.reason = "Unknown"

End Select

.Update

.MoveNext

Wend

End With

rstTEMPY.Close
dbsCurrent.Close
wrkJET.Close
Set rstTEMPY = Nothing
Set dbsCurrent = Nothing
Set wrkJET = Nothing

dbs.Execute "CREATE INDEX NewIndexX ON TEMPX (SKU);"
dbs.Execute "CREATE INDEX NewIndexY ON TEMPY (SKU);"

'DEFINE REPORT
CR1.ReportFileName = "MEDETAIL.rpt"

'PUT REPORT TITLE AND MONTH IN FORMULA FOR CRYSTAL REPORTS TO USE.
CR1.Formulas(0) = "USERMONTH= " _
& "'" & theCurrentMonth & "'"

'RUN REPORT
CR1.Action = 1

Close
Set dbs = Nothing
End Sub 'END OF cmdMonthEndDetailRpt

VB6 - SQL

'CODE FOR A MULTIPLE QUERIES FORM

Private Sub cmdClose_Click()
Me.Hide
End Sub

'USE ANOTHER FORM TO GET DATE RANGE
Private Sub cmdDR_Click()
frmDATERANGE.Show
Me.Refresh
End Sub

Private Sub cmdReceipt_Click()
If varRO = "R" Then
varRO = ""
cmdReceipt.Caption = "Click for &Receipts Only (TR30 and TR36)"
Else
varRO = "R"
cmdReceipt.Caption = "Receipts Only Option Selected"
cmdOrder.Caption = "Click for &Orders Only   (TR80 and TR82)"
cmdWorkOrder.Caption = "Click for &Work Orders Only   (TR40)"
End If
End Sub

Private Sub cmdOrder_Click()
If varRO = "O" Then
varRO = ""
cmdOrder.Caption = "Click for &Orders Only   (TR80 and TR82)"
Else
varRO = "O"
cmdOrder.Caption = "Orders Only Option Selected"
cmdReceipt.Caption = "Click for &Receipts Only (TR30 and TR36)"
cmdWorkOrder.Caption = "Click for &Work Orders Only   (TR40)"
End If
End Sub

Private Sub cmdWorkOrder_Click()
If varRO = "W" Then
varRO = ""
cmdWorkOrder.Caption = "Click for &Work Orders Only   (TR40)"
Else
varRO = "W"
cmdWorkOrder.Caption = "Work Orders Only Option Selected"
cmdReceipt.Caption = "Click for &Receipts Only (TR30 and TR36)"
cmdOrder.Caption = "Click for &Orders Only   (TR80 and TR82)"
End If
End Sub
Private Sub cmdReset_Click()

varRO = ""
cmdReceipt.Caption = "Click for &Receipts Only (TR30 and TR36)"
cmdOrder.Caption = "Click for &Orders Only   (TR80 and TR82)"
cmdWorkOrder.Caption = "Click for &Work Orders Only   (TR40)"

varDR = False

varSingleSKU = ""
txtSKU.Text = ""

varSingleAcctCode = ""
txtACCOUNTCODE.Text = ""

varSinglePOnumber = ""
txtPOnumber.Text = ""

End Sub

Private Sub cmdSEARCH_click(x)
End Sub

Private Sub cmdSEARCHX_Click()

Dim dbs As Database
Set dbs = OpenDatabase(gsDatabase)

cmdSEARCHX.Caption = "Working..."

'First we select out the user requested date range.

Me.Refresh
On Error Resume Next
dbs.Execute "DROP TABLE [TEMPX];"
Err.Clear

If varDR Then 'get the specified date range

supervarS = CStr(varSTARTDATE)
supervarE = CStr(varENDDATE)

strSQL = "SELECT * INTO TEMPX " _
& "From TRANSACTION WHERE " _
& "(((TRANSACTION.THEDATE)>=#" & supervarS & "#)) AND " _
& "(((TRANSACTION.THEDATE)<=#" & supervarE & "#));"
dbs.Execute (strSQL)

Else 'make copy of entire transaction file

strSQL = "SELECT * INTO TEMPX From TRANSACTION;"
dbs.Execute (strSQL)

End If

'Next we check if user wants Receipt-Only, Orders-Only, Work Orders-Only or all.

On Error Resume Next
dbs.Execute "DROP TABLE [TEMPY];"
Err.Clear

If varRO = "R" Then 'get receipts only

strSQL = "SELECT * INTO TEMPY " _
& "From TEMPX WHERE " _
& "TEMPX.TRCODE = '30' OR TEMPX.TRCODE = '36';"
dbs.Execute (strSQL)

Else
End If

If varRO = "O" Then 'get orders only

strSQL = "SELECT * INTO TEMPY " _
& "From TEMPX WHERE " _
& "TEMPX.theTYPE = 'M2' OR TEMPX.theTYPE = 'M3';"
dbs.Execute (strSQL)

Else
End If

If varRO = "W" Then 'get work orders only

strSQL = "SELECT * INTO TEMPY " _
& "From TEMPX WHERE " _
& "TEMPX.TRCODE = '40';"
dbs.Execute (strSQL)

Else
End If

If varRO = "" Then 'keep everything
strSQL = "SELECT * INTO TEMPY From TEMPX;"
dbs.Execute (strSQL)
Else
End If

'We've taken care of the dateRange and the R vs O scenarios
'Next let's do the Single Account

On Error Resume Next
dbs.Execute "DROP TABLE [TEMPZ];"
Err.Clear

If txtACCOUNTCODE.Text = "" Then 'user doesn't want a single account
strSQL = "SELECT * INTO TEMPZ From TEMPY;"
dbs.Execute (strSQL)
Else 'user wants data only for a single account
varSingleAcctCode = CStr(txtACCOUNTCODE.Text)
strSQL = "SELECT * INTO TEMPZ " _
& "From TEMPY WHERE " _
& "(((TEMPY.ACCTCODE)='" & varSingleAcctCode & "'));"
dbs.Execute (strSQL)
End If

'Now let's do the single P.O.

On Error Resume Next
dbs.Execute "DROP TABLE [TEMPX];"
Err.Clear

If txtPOnumber.Text = "" Then 'user doesn't want a single P.O. number
strSQL = "SELECT * INTO TEMPX From TEMPZ;"
dbs.Execute (strSQL)
Else 'user wants data only for a P.O.
varSinglePOnumber = CStr(txtPOnumber.Text)
strSQL = "SELECT * INTO TEMPX " _
& "From TEMPZ WHERE " _
& "(((TEMPZ.PO_NUMBER)='" & varSinglePOnumber & "'));"
dbs.Execute (strSQL)
End If

'Last is the single SKU scenario,
'this calls for a different output than the rest
If txtSKU.Text = "" Then 'processing is done, show output to user
frmX.Show
Else 'this is the single SKU scenario, processing continues
'first we get the records for the requested SKU
On Error Resume Next
dbs.Execute "DROP TABLE [TEMPY];"
Err.Clear
varSingleSKU = CStr(txtSKU.Text)
strSQL = "SELECT * INTO TEMPY " _
& "From TEMPX WHERE " _
& "(((TEMPX.SKU)='" & varSingleSKU & "'));"
dbs.Execute (strSQL)
'next we get the SKU description, etc. data
On Error Resume Next
dbs.Execute "DROP TABLE [TEMPZ];"
Err.Clear
strSQL = "SELECT * INTO TEMPZ " _
& "From TEMPY INNER JOIN THESKUFILE ON " _
& "TEMPY.SKU=THESKUFILE.SKU;"
dbs.Execute (strSQL)
frmZ.Show
End If

endOfJobHK:
cmdSEARCH.Caption = "Search and Display Results"
dbs.Close
Set dbs = Nothing
End Sub

varRO = ""
cmdReceipt.Caption = "Click for &Receipts Only (TR30 and TR36)"
cmdOrder.Caption = "Click for &Orders Only   (TR80 and TR82)"
cmdWorkOrder.Caption = "Click for &Work Orders Only   (TR40)"

varDR = False

varSingleSKU = ""
txtSKU.Text = ""

varSingleAcctCode = ""
txtACCOUNTCODE.Text = ""

varSinglePOnumber = ""
txtPOnumber.Text = ""

End Sub 'END OF CODE FOR A QUERIES FORM

VB6

Private Sub cmdOPTIMIZE_Click() 'COMPACT THE ACCESS DATABASE

Dim tempvar As String
Dim tempvarX As String
Dim fileName As String
Dim dirFileName As String
Dim SourceFile, DestinationFile

Close
Set dbs = Nothing
Set SourceFile = Nothing
Set DestinationFile = Nothing
'Set status bar.
With sbStatusBar
'This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = "Working..."
.Style = sbrSimple  ' Simple style.
Refresh
End With

'Create backup file name.
tempvar = "XX"
tempvarX = Trim(Str(Format(Date, "mmddyy")))
fileName = tempvar + tempvarX + ".mdb"
dirFileName = "XXXBU\" + fileName

'Make sure there isn't already a file with the name of the compacted database.
On Error GoTo errorRTN2
If Dir(dirFileName) <> "" Then Kill dirFileName

'Makes temp backup before optimization.
On Error GoTo errorRTN2
If Dir("tempBU.mdb") <> "" Then Kill "tempBU.mdb"
SourceFile = "XXX.mdb"          'Define source file name.
DestinationFile = "tempBU.mdb"  'Define target file name.
On Error GoTo errorRTN2
FileCopy SourceFile, DestinationFile    ' Copy source to target.

'Compacts (optimizes) the database.
On Error GoTo errorRTN2
DBEngine.CompactDatabase "XXX.mdb", dirFileName

'Copies optimized database over the original.
On Error GoTo errorRTN2
If Dir("XXX.mdb") <> "" Then Kill "CST.mdb"
SourceFile = dirFileName        'Define source file name.
DestinationFile = "XXX.mdb"     'Define target file name.
On Error GoTo errorRTN2
FileCopy SourceFile, DestinationFile    ' Copy source to target.
MsgBox ("Database optimized and a " + dirFileName + " backup copy made.")

Close
tempvar = ""
tempvarX = ""
fileName = ""
dirFileName = ""
Set SourceFile = Nothing
Set DestinationFile = Nothing

Exit Sub

errorRTN2:
MsgBox ("File conflict problem.  Exit/Restart application and try again.")

End Sub 'END OF OPTIMIZE/COMPACT PROGRAM

VB6

Private Sub cmdBACKUPdatabase_Click() 'BACKUP THE DATABASE

Dim tempvar As String
Dim tempvarX As String
Dim fileName As String
Dim dirFileName As String
Dim SourceFile, DestinationFile

Close
tempvar = ""
tempvarX = ""
fileName = ""
dirFileName = ""

Set dbs = Nothing
Set SourceFile = Nothing
Set DestinationFile = Nothing

'Set status bar.
With sbStatusBar
' This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = "Working..."
.Style = sbrSimple  ' Simple style.
Refresh
End With

'Create backup file name.
tempvar = "XX"
tempvarX = Trim(Str(Format(Date, "mmddyy")))
fileName = tempvar + tempvarX + ".mdb"
dirFileName = "XXBU\" + fileName

'Make sure there isn't already a file with the name of the backup file.
If Dir(dirFileName) <> "" Then Kill dirFileName

' Make the Backup.
SourceFile = "XX.mdb"             'Define source file name.
DestinationFile = dirFileName      'Define target file name.
On Error GoTo errorRTN
FileCopy SourceFile, DestinationFile    ' Copy source to target.

Me.sbStatusBar.Style = sbrNormal  ' Normal style.
MsgBox ("A Backup copy named " + dirFileName + " has been made.")

Close
tempvar = ""
tempvarX = ""
fileName = ""
dirFileName = ""
Set SourceFile = Nothing
Set DestinationFile = Nothing
'Me.Hide
'Me.Show

Exit Sub

errorRTN:
MsgBox ("File conflict problem.  Exit/Restart application and try again.")

End Sub 'END OF DATABASE BACKUP PROGRAM

VB6
'=======================================================
'PRINT FORM CODE
Private Sub cmdPrintScreen_Click()
Me.PrintForm
End Sub
'=======================================================
'EXIT APPLICATION CODE
Private Sub cmdEXIT_Click() 'EXIT APPLICATION
End
End Sub 'END OF EXIT AP
'=======================================================
'Use Wizard
'=======================================================

## Visual Basic 6.0 and SQL Code Examples Library Two - Beginner and Advanced

VB6

Private Sub cmdWMSupdate_Click() 'CHAINING TOGETHER SUBROUTINES, ETC.

Dim Uchoice As Integer

XX = Trim(InputBox("Please enter date.", "THE TARGET DATE", "mm/dd/yy"))
If XX <> "" And XX <> "mm/dd/yy" Then
theLatestDate = CDate(XX)
Else
MsgBox ("Invalid Date. Process cancelled.")
varCANCEL = True
GoTo NeverMind
End If

theEarliestDate = DateAdd("d", -1, Format(theLatestDate, "mm") + "/01/" + Format(theLatestDate, "yy"))

varSTARTDATE = CDate(theEarliestDate) 'global save for later use.
varENDDATE = CDate(theLatestDate) 'global save for later use.

Uchoice = MsgBox("Please insert the PCfile.txt disk into drive A:", vbOKCancel)
Me.Refresh
If Uchoice = 2 Then
Uchoice = MsgBox("No disk, but will update database totals.", vbOKCancel)
If Uchoice = 2 Then
GoTo NeverMind  'ie: bail out of this procedure
Else
GoTo JustUpdateTotals
End If
Else
'Proceed...
varCANCEL = False
varPROCEED = True
End If

Me.Refresh
theMSG = "Emptying old data from TEMPUP table."
With sbStatusBar
'This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = theMSG
.Style = sbrSimple  ' Simple style.
End With
Me.Refresh
Call cmdWMSupdate1  'EMPTY'S TEMPUP TABLE

theMSG = "Importing data from diskette in A:drive."
With sbStatusBar
'This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = theMSG
.Style = sbrSimple  ' Simple style.
End With
Me.Refresh
Call cmdWMSupdate2 '  IMPORTS DISKETTE DATA INTO TEMPUP

If varCANCEL Then  '  INVALID DATE.
MsgBox ("Invalid Date. Process cancelled.")
GoTo NeverMind
Else
End If

theMSG = "Checking for duplicate records."
With sbStatusBar
'This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = theMSG
.Style = sbrSimple  ' Simple style.
End With
Me.Refresh
Call cmdWMSupdate3 'CHECK FOR DUPLICATE RECORDS

If varCANCEL Then  'THERE WERE DUPS OR USER CANCELED FOR SOME REASON.
MsgBox ("Process canceled.")
GoTo NeverMind
Else
End If

theMSG = "Doing this, that, and the other in the TEMPUP table."
With sbStatusBar
'This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = theMSG
.Style = sbrSimple  ' Simple style.
End With
Me.Refresh
Call cmdWMSupdate4  'MAKES ALL THE SPECIFIED CHANGES IN TEMPUP
'AND CHECKS FOR NEW SKU'S.

If varCANCEL Then
GoTo NeverMind 'THERE ARE MISSING SKU NUMBERS
Else
End If

theMSG = "Data review mode."
With sbStatusBar
'This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = theMSG
.Style = sbrSimple  ' Simple style.
End With
Me.Refresh

'    Call cmdWMSupdateShow '  VIEWS IMPORTED/PROCESSED TEMPUP.
'
'    'USER GIVEN CHANCE TO BAIL OUT BEFORE MERGING DATA WITH PRODUCTION FILES
'    Uchoice = MsgBox("Ready to merge with Production Files.  Continue?", vbYesNoCancel, "Decision Point")
'    If Uchoice <> "6" Then '"6" means "yes"
'        MsgBox ("Process canceled. Production files still not touched.")
'        GoTo NeverMind
'    End If

theMSG = "Updating production files."
With sbStatusBar
'This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = theMSG
.Style = sbrSimple  ' Simple style.
End With
Me.Refresh
Call cmdWMSupdate5 'TRANSFER DATA FROM TEMPUP TO PRODUCTION

JustUpdateTotals:

Call cmdWMSupdate6 'UPDATE SKU FILE QUANTITY TOTALS

MsgBox ("Production files updated.")

NeverMind:
With sbStatusBar
.Style = sbrNormal  ' Normal style.
End With
Close
Me.Refresh

End Sub 'END OF MAIN IMPORT PROGRAM THAT CALLS ALL THE OTHER RELATED SUBPROGRAMS.

VB6 and SQL

Private Sub cmdWMSupdate1() 'EMPTY TEMPUP TABLE

Dim dbs As Database

Set dbs = OpenDatabase(gsDatabase)

dbs.Execute "DELETE * FROM TEMPUP;"

dbs.Close

Set dbs = Nothing

End Sub 'END OF EMPTY TEMPUP TABLE PROGRAM.

VB6

Private Sub cmdWMSupdate2() 'Import text data from disk in A:drive into the TEMPUP table.

Dim theRecord As Record  ' "Record" defined in DECLARATIONS section of MODULE1.bas
Dim theRecNo As Integer

Open "A:\PCFILE.TXT" For Random As #1 Len = Len(theRecord) + 2
theRecNo = 1

'    Record 'Description of record content
'    theTYPE As String * 2
'    SKU As String * 6
'    QTY As String * 5
'    PO_NUMBER As String * 10
'    VEND As String * 4
'    XYZ_NUMBER As String * 24
'    ABCNO As String * 10
'    theDATE As String * 8
'    VVV_NUMBER As String * 11
'    TRCODE As String * 2
'    SCRAP As String * 174

Set wrkJET = CreateWorkspace("", "admin", "", dbUseJet)
Set dbsCurrent = wrkJET.OpenDatabase(gsDatabase, True)
Set rstTEMPUP = dbsCurrent.OpenRecordset("tempup")

Do While Not EOF(1) ' Loop until end of file.
Get #1, theRecNo, theRecord
With rstTEMPUP
If theRecord.SKU > "111" Or theRecord.theTYPE > "a" Then
.theTYPE = theRecord.theTYPE
.SKU = theRecord.SKU
.QTY = theRecord.QTY
.PO_NUMBER = theRecord.PO_NUMBER
.VEND = theRecord.VEND
.XYZ_NUMBER = theRecord.XYZ_NUMBER
.ABCNO = theRecord.ABCNO
.theDATE = varENDDATE
.Update
Else
End If
End With
theRecNo = theRecNo + 1
Loop

'With rstTEMPUP
'    .MoveLast
'    If .SKU < "111" Or .theTYPE < "a" Then
'        .Edit      'Gets rid of
'        .Delete    'blank record at end
'        .MovePrevious
'    Else
'    End If
'End With

'With rstTEMPUP
'    .MoveLast
'    If .SKU < "111" Or .theTYPE < "a" Then
'        .Edit      'Gets rid of
'        .Delete    'blank record at end
'        .MovePrevious
'    Else
'    End If
'End With

Close #1            ' Close text file.

rstTEMPUP.Close     ' Close Access file.
dbsCurrent.Close    ' Close Access database.
wrkJET.Close
Set rstTEMPUP = Nothing
Set dbsCurrent = Nothing
Set wrkJET = Nothing

NeverMind:

End Sub 'END OF IMPORT TEXT DATA INTO TEMPUP

VB6 and SQL

Private Sub cmdWMSupdate3() 'CHECK FOR DUPS

Dim dbs As Database
Dim supervar As Date
Dim strSQL As String
Dim rst As Recordset

Set dbs = OpenDatabase(gsDatabase)

'do some insurance cleanup, sometimes drop table doesn't work
On Error Resume Next
dbs.Execute "DELETE * FROM TRANSDUPCHECK;"
Err.Clear
On Error Resume Next
dbs.Execute "DELETE * FROM TRANSDUPCHECK2;"
Err.Clear
On Error Resume Next
dbs.Execute "DELETE * FROM DUPSLIST;"
Err.Clear

dbs.Close
Set dbs = Nothing
Set dbs = OpenDatabase(gsDatabase)

supervar = varSTARTDATE

'FIRST WE SELECT OUT THE MTD TRANSACTION RECORDS
On Error Resume Next
dbs.Execute "DROP TABLE [TRANSDUPCHECK];"
Err.Clear

strSQL = "SELECT XXX_NUMBER, SKU, QTY INTO TRANSDUPCHECK " _
& "From TRANSACTION WHERE " _
& "(((TRANSACTION.THEDATE)>#" & supervar & "#)) AND " _
& "(TRANSACTION.TRCODE) <>'40';"
dbs.Execute (strSQL)

'NEXT WE SELECT OUT THE SAME THREE CHECK FIELDS FROM TEMPUP
On Error Resume Next
dbs.Execute "DROP TABLE [TRANSDUPCHECK2];"
Err.Clear

strSQL = "SELECT XXX_NUMBER, SKU, QTY INTO TRANSDUPCHECK2 " _
& "From TEMPUP WHERE TRCODE <>'40';"
dbs.Execute (strSQL)

'NEXT WE COMBINE THE TWO TABLES INTO ONE
strSQL = "INSERT INTO TRANSDUPCHECK " _
& "SELECT * FROM TRANSDUPCHECK2;"
dbs.Execute (strSQL)

'NOW WE CHECK FOR DUPLICATE RECORDS AND PUT DUPLICATES IN DUPLIST TABLE.
On Error Resume Next
dbs.Execute "DROP TABLE [DUPSLIST];"
Err.Clear

strSQL = "SELECT DISTINCTROW " _
& "First(TRANSDUPCHECK.XXX_NUMBER) AS [XXX_NUMBER Field], " _
& "First(TRANSDUPCHECK.SKU) AS [SKU Field], " _
& "First(TRANSDUPCHECK.QTY) AS [QTY Field], " _
& "Count(TRANSDUPCHECK.XXX_NUMBER) AS NumberOfDups " _
& "INTO DUPSLIST From TRANSDUPCHECK " _
& "GROUP BY TRANSDUPCHECK.XXX_NUMBER, " _
& "TRANSDUPCHECK.SKU, TRANSDUPCHECK.QTY " _
& "HAVING (((Count(TRANSDUPCHECK.XXX_NUMBER))>1) " _
& "AND ((Count(TRANSDUPCHECK.QTY))>1));"
dbs.Execute (strSQL)

'GIVE USER CHANCE TO VIEW DUPS (IF ANY).

With dbs
' Open table-type Recordset and show RecordCount
' property.
Set rst = .OpenRecordset("DUPSLIST")
If rst.RecordCount > 0 Then
On Error Resume Next
Call cmdWMSduplicateShow
Err.Clear
Else
End If
On Error Resume Next
rst.Close
Err.Clear
End With

NeverMind3:
Close
Set dbs = Nothing

End Sub 'END OF DUPLICATES SEARCH

VB6

Private Sub cmdWMSupdateShow() ' GIVE USER CHANCE TO VIEW TEMPUP AND BAIL OUT IF NEEDED.

Dim f As New frmTEMPUP
Dim ff As New frmDataGrid
f.Show
Set ff.Data1.Recordset = f.Data1.Recordset
ff.Caption = "Processed TEMPUP(pcfile.txt) data"
ff.Show 1
ff.Hide
f.Hide

End Sub 'TEMPUP FORM

Private Sub cmdWMSduplicateShow() 'GIVES USER VIEW OF DUPLICATES

Dim f As New frmDUPLIST
Dim ff As New frmDataGrid
f.Show
Set ff.Data1.Recordset = f.Data1.Recordset
ff.Caption = f.Caption
ff.Show 1
ff.Hide
f.Hide
f.Show 1
f.Hide

End Sub 'DUPLIST FORM SHOWING DUPSFOUND TABLE

VB6

Private Sub cmdWMSupdate4() '  MAKES ALL THE SPECIFIED CHANGES IN TEMPUP

Dim thedate As Date
Dim IBmsg As String
Dim IBtitle As String
Dim IBdefault As String

ICSdate = varENDDATE 'SETS XXX DATE FROM EARLIER USER INPUT.

Set wrkJET = CreateWorkspace("", "admin", "", dbUseJet)
Set dbsCurrent = wrkJET.OpenDatabase(gsDatabase, True)
Set rstTEMPUP = dbsCurrent.OpenRecordset("TEMPUP")
Set rstSKU = dbsCurrent.OpenRecordset("THEGFILE")

theMSG = "Modifying the TEMPUP table with all the changes,fixes, etc."
With sbStatusBar
'This text will be displayed when the StatusBar is in Simple style.
.Style = sbrNormal  ' Normal style.
.SimpleText = theMSG
.Style = sbrSimple  ' Simple style.
End With
Me.Refresh

Counter = 0

With rstTEMPUP

.MoveFirst

While Not .EOF
Counter = Counter + 1
Debug.Print CStr(Counter)
.Edit

'PUTS THE PROC DATE IN DATE FIELD.
.theDATE = xxxdate

'UPDATES ALL TYPE XYZ ORDERS TO CODE 80.
If .theTYPE = "M2" And Mid(.XXX_NUMBER, 19, 1) <> "1" Then
.TRCODE = "80"
End If

'UPDATES the M2 RECORDS WITH CODE "82".
If .theTYPE = "M2" And Mid(.XXX_NUMBER, 19, 1) = "1" Then
.TRCODE = "82"
End If

'EXTRACTS ACCOUNT CODE AND UPDATES M2 RECORDS.
If .theTYPE = "M2" And IsNull(.ACCTCODE) Then
.ACCTCODE = Left(.XXX_NUMBER, 13)
Else
End If

'UPDATES THE RECEIVING RECORDS TO CODES 30 AND 36.
If .theTYPE = "R1" Then
.TRCODE = "30"
End If
If .theTYPE = "R2" Then
.TRCODE = "36"
End If

'UPDATES THE WORKORDERS TO CODE 40
If .theTYPE = "P1" Or .theTYPE = "P2" Then
.TRCODE = "40"
End If

'UPDATES THE WORKORDER'S WORKORDER# FROM THE WWW NUMBER FIELD.
If .TRCODE = "40" Then
.wo_number = Trim(.WWW_NUMBER)
.WWW_NUMBER = Null
Else
End If

'UPDATES THE CLAIM CODE
If .theTYPE = "C1" Or .theTYPE = "C2" Then
.TRCODE = "50"
.ACCTCODE = Trim(.XXX_NUMBER)
.XXX_NUMBER = Null
Else
End If

If .theTYPE = "A1" Or .theTYPE = "A2" Then
.TRCODE = "62"
Else
End If

'V2 update
If theTYPE = "V2" Then
.TRCODE = "72"
Else
End If

'V1 update
If theTYPE = "V1" Then
.TRCODE = "75"
Else
End If

'CHECK FOR ANY NEW SKU'S.
SKUtransVar = Trim(CStr(.SKU))
'strCountry = "Country = '" & strCountry & "'"
With rstSKU
.Index = "PrimaryKey"
.Seek "=", SKUtransVar
If .NoMatch Then
theMSGX = "SKU " + CStr(SKUtransVar) + " NOT FOUND! UPDATE SKUFILE FILE AND RERUN PROGRAM."
MsgBox (theMSGX)
varCANCEL = True
Else
End If
End With
.Update
.MoveNext
If varCANCEL Then
GoTo theNext
End If
Wend
End With

theNext:
rstTEMPUP.Close
rstSKU.Close
dbsCurrent.Close
wrkJET.Close
Set rstTEMPUP = Nothing
Set rstSKU = Nothing
Set dbsCurrent = Nothing
Set wrkJET = Nothing

End Sub 'END OF UPDATING TRCODES AND CHECKING FOR MISSING(NEW) SKU'S

VB6 and SQL

Private Sub cmdWMSupdate5()
'TRANSFER DATA FROM TEMPUP TO:
'TRANSACTION AND QQQ FILES
'PUT VEND NUMBER FROM SKU FILE INTO TRANSACTION FILE

Dim Counter As Integer

'OPEN DATABASE AND TABLES
Set wrkJET = CreateWorkspace("", "admin", "", dbUseJet)
Set dbsCurrent = wrkJET.OpenDatabase(gsDatabase)

Set rstTEMPUP = dbsCurrent.OpenRecordset("TEMPUP")
Set rstTRANSACTION = dbsCurrent.OpenRecordset("TRANSACTION")
Set rstMANFILE = dbsCurrent.OpenRecordset("PPPFILE")
Set rstCUSTOMER = dbsCurrent.OpenRecordset("CUSTOMER")
Set rstTRANCODE = dbsCurrent.OpenRecordset("TRANCODE")
Set rstVENDOR = dbsCurrent.OpenRecordset("VENDOR")
Set rstSKU = dbsCurrent.OpenRecordset("SKUFILE")

'FIRST WE TRANSFER TEMPUP DATA TO TRANSACTION

'On Error GoTo theNext
Counter = 0
With rstTEMPUP
.MoveFirst
While Not .EOF
Counter = Counter + 1
'FIRST WE TRANSFER TEMPUP DATA TO TRANSACTION TABLE
rstTRANSACTION.MoveLast
rstTRANSACTION.Edit
rstTRANSACTION.XXX_NUMBER = .XXX_NUMBER
rstTRANSACTION.PPP = .PPPNO
rstTRANSACTION.SKU = .SKU
rstTRANSACTION.QTY = .QTY
rstTRANSACTION.ZZZDATE = .theDATE
rstTRANSACTION.theTYPE = .theTYPE
rstTRANSACTION.QQQ_NUMBER = .QQQ_NUMBER
rstTRANSACTION.TRCODE = .TRCODE
rstTRANSACTION.VEND = .VEND
rstTRANSACTION.ACCTCODE = .ACCTCODE
rstTRANSACTION.wo_number = .wo_number
rstTRANSACTION.PO_NUMBER = .PO_NUMBER
'NEXT WE FIGURE OUT THE VEND NUMBER AND
'PLUG IT INTO THE TRANSACTION FILE
If rstTRANSACTION.VEND < "1" Then
SKUtransVar = Trim(CStr(rstTRANSACTION.SKU))
With rstSKU
.Index = "PrimaryKey"
.Seek "=", SKUtransVar
'.FindFirst SKUtransVar
If .NoMatch Then
MsgBox ("SKU STILL NOT FOUND! VENDOR SET TO 9999.")
rstTRANSACTION.VEND = "9999"
Else
rstTRANSACTION.VEND = Trim(CStr(.VENDOR))
End If
End With
Else
End If
rstTRANSACTION.Update
.MoveNext
Wend
End With

rstTEMPUP.Close     ' Close files.
rstTRANSACTION.Close
rstVVVFILE.Close
rstCUSTOMER.Close
rstTRANCODE.Close
rstVENDOR.Close
rstSKU.Close
Set rstTEMPUP = Nothing
Set rstTRANSACTION = Nothing
Set rstEEEFILE = Nothing
Set rstCUSTOMER = Nothing
Set rstTRANCODE = Nothing
Set rstVENDOR = Nothing
Set rstSKU = Nothing

'LAST WE TRANSFER SAME TEMPUP DATA TO OTHERFILE
strSQL = "INSERT INTO OTHERFILE " _
& "(XNO, YDATE) " _
& "SELECT DISTINCT " _
& "TEMPUP.XNO, TEMPUP.YDATE " _
& "FROM TEMPUP WHERE " _
& "(((TEMPUP.XNO) Is Not Null));"
dbsCurrent.Execute (strSQL)

theNext:
'Err.Clear

dbsCurrent.Close    ' Close database.
wrkJET.Close
Set dbsCurrent = Nothing
Set wrkJET = Nothing

End Sub 'END OF MOVING TEMPUP DATA TO TRANSACTION AND OTHERFILE, AND MOVING SKU VEND TO TRANSACTION

VB6 and SQL

Private Sub cmdWMSupdate6() 'UPDATE SKU TOTALS

Dim dbs As Database
Dim supervar As Date
Dim strSQL As String

Set dbs = OpenDatabase(gsDatabase)

thePrevMonthX = DateAdd("m", -1, varENDDATE)
ThePrevMonth = CStr(UCase(CStr(Format(thePrevMonthX, "mmm"))))

On Error Resume Next
dbs.Execute "DROP TABLE [TEMPX];"
Err.Clear
On Error Resume Next
dbs.Execute "DROP TABLE [TEMPY];"
Err.Clear

supervar = varSTARTDATE

'FIRST WE SELECT OUT THE MTD TRANSACTION RECORDS
strSQL = "SELECT THEDATE, theTYPE, SKU, QTY INTO TEMPX " _
& "From TRANSACTION WHERE " _
& "(((TRANSACTION.THEDATE)>#" & supervar & "#));"
dbs.Execute (strSQL)

'NEXT WE CONVERT ALL THE INVENTORY REDUCTION
'TRANSACTIONS QTY'S TO NEGATIVE NUMBERS.
strSQL = "UPDATE TEMPX " _
& "SET QTY = QTY*(-1) " _
& "WHERE MID(theTYPE,2,1) = 2;"
dbs.Execute (strSQL)

'NEXT WE ADD UP ALL THE QTYS PER SKU.
strSQL = "SELECT DISTINCTROW TEMPX.SKU, " _
& "SUM(TEMPX.QTY) AS [QTYTTLS] " _
& "INTO TEMPY " _
& "FROM TEMPX GROUP BY TEMPX.SKU;"
dbs.Execute (strSQL)

'reset current balance to start of month
strSQL = "UPDATE SKUFILE " _
& "SET CURR_BAL = " _
& ThePrevMonth _
& ";"
dbs.Execute (strSQL)

'LAST WE ADD THESE TOTALS TO THE SKU CURRENT BALANCE.
strSQL = " UPDATE SKUFILE LEFT JOIN " _
& "TEMPY ON SKUFILE.SKU = TEMPY.SKU " _
& "SET SKUFILE.CURR_BAL = [CURR_BAL] + [QTYTTLS] " _
& "WHERE (((TEMPY.QTYTTLS) Is Not Null));"
dbs.Execute (strSQL)

dbs.Close

Set dbs = Nothing
strSQL = ""
'DATA IMPORT AND ALL PROCESSING DONE.

End Sub 'END OF UPDATE SKU CURRENT BALANCE TOTALS

## MESSING AROUND VB6 STATISTICAL CODE - Mostly beginner, excepting maybe for arrays

 Binary City
This third segment you are now on has mostly beginner stuff, plus the not-so-beginner usage of arrays. This is some code I wrote and used awhile back for some fun statistical analysis work; is not work code; is not professional standard code; this segment is just fun, messing around code. This is programmer "worker-code", in that snippets were constantly being moved around and alternated to try different scenarios, thus the plethora of commented lines that you will see. The purpose of this page is to give lots and lots of examples of debugged syntax, nothing more.

Comparator = inputComparator
Comparator2 = inputComparator2
Comparator3 = inputComparator3
Comparator4 = inputComparator4
End Sub

Private Sub inputComparator_Change()
Comparator = inputComparator
Comparator2 = inputComparator2
Comparator3 = inputComparator3
Comparator4 = inputComparator4
End Sub
Private Sub inputComparator2_Change()
Comparator = inputComparator
Comparator2 = inputComparator2
Comparator3 = inputComparator3
Comparator4 = inputComparator4
End Sub
Private Sub inputComparator3_Change()
Comparator = inputComparator
Comparator2 = inputComparator2
Comparator3 = inputComparator3
Comparator4 = inputComparator4
End Sub
Private Sub inputComparator4_Change()
Comparator = inputComparator
Comparator2 = inputComparator2
Comparator3 = inputComparator3
Comparator4 = inputComparator4
End Sub
Private Sub InputEraseYN_Change()
If InputEraseYN = "y" Or InputEraseYN = "Y" Then
EraseYN = True
Else
EraseYN = False
End If

End Sub

Public Comparator As Integer
Public Comparator2 As Integer
Public Comparator3 As Integer
Public Comparator4 As Integer
Public cvara, cvarb, cvarc, cvard, cvare, cvarf As Integer
Public fvara, fvarb, fvarc, fvard, fvare, fvarf As Field
Public EraseYN As Boolean

Private Sub ComboND_Click()

Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\combo\combo2010.mdb")
Set rstTEMPY = dbs.OpenRecordset("ff")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 55
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank

.Update
.MoveNext
Wend
End If

cvara = 5
cvarb = 3
cvarc = 1
cvard = 1111
cvare = 1111
cvarf = 1111

.MoveFirst
'.Move 1180

'.Move 365

While Not .EOF  'combo NEXT DAY

'If .d3da = 9 Or .d3db = 9 Or .d3dc = 9 Or .d3na = 9 Or .d3nb = 9 Or .d3nc = 9 Then

'If .d3da = cvara Then
'If .d3db = cvarb Then 'predicted A of daily derby
'If .d3dc = cvarc Then 'predicted 2 of the fantasy 5's

'If .d3da = cvara And .d3db = cvarb Then  'predicted B of daily derby, 'kind of predicted C of daily derby
'If .d3da = cvara And .d3dc = cvarc Then
'If .d3db = cvarb And .d3dc = cvarc Then
'If .d3da = cvara And .d3db = cvarb And .d3dc = cvarc Then

'If .d3da = cvara Or .d3db = cvarb Then 'kind of predicted A of daily derby
'If .d3da = cvara Or .d3dc = cvarc Then
'If .d3db = cvarb Or .d3dc = cvarc Then  'kind of predicted B of daily derby
'If .d3da = cvara Or .d3db = cvarb Or .d3dc = cvarc Then 'kind of predicted B of daily derby

'If .f5b > 15 And .f5d < 25 Then
'If .f5b = .f5a + 1 And .f5d = .f5c + 1 Then
'If .f5b = .f5a + 1 Then
'If .f5d = .f5c + 1 Then

'If .f5c = .f5b + 1 And .f5d = .f5c + 1 Then
'If .f5c > 32 Then
'If .d3nc = 1 Then
'If True Then
'DAILY DERBY COMPARE
'If .dda = Comparator Then

'If (.dda = Comparator Or .DDB = Comparator Or .DDc = Comparator) Then
'If (ddd = Comparator Or .dde = Comparator Or .ddf = Comparator) Then
'If (ddd = Comparator And .dde = Comparator And .ddf = Comparator) Then
'If (.dda = Comparator Or .DDB = Comparator Or .ddc = Comparator Or .ddd = Comparator Or .dde = Comparator) Then
'If (.dda = Comparator Or .ddb = Comparator Or .ddc = Comparator Or .ddd = Comparator Or .dde = Comparator) And (.dda = Comparator2 Or .ddb = Comparator2 Or .ddc = Comparator2 Or .ddd = Comparator2 Or .dde = Comparator2) Then
'If (.dda = Comparator Or .ddb = Comparator Or .ddc = Comparator Or .ddd = Comparator Or .dde = Comparator) And (.dda = Comparator2 Or .ddb = Comparator2 Or .ddc = Comparator2 Or .ddd = Comparator2 Or .dde = Comparator2) And (.dda = Comparator3 Or .ddb = Comparator3 Or .ddc = Comparator3 Or .ddd = Comparator3 Or .dde = Comparator3) Then

'If .dde = 2 And .ddf = 0 Then

'If .f5c = 18 Then

'FANTASY FIVE COMPARE
'If (.f5a = Comparator Or .f5B = Comparator Or .f5c = Comparator Or .f5d = Comparator Or .f5e = Comparator) Then
'If (.f5a = Comparator Or .f5B = Comparator Or .f5c = Comparator Or .f5d = Comparator Or .f5e = Comparator) And (.f5a = Comparator2 Or .f5B = Comparator2 Or .f5c = Comparator2 Or .f5d = Comparator2 Or .f5e = Comparator2) Then
If (.f5a = Comparator Or .f5B = Comparator Or .f5c = Comparator Or .f5d = Comparator Or .f5e = Comparator) And (.f5a = Comparator2 Or .f5B = Comparator2 Or .f5c = Comparator2 Or .f5d = Comparator2 Or .f5e = Comparator2) And (.f5a = Comparator3 Or .f5B = Comparator3 Or .f5c = Comparator3 Or .f5d = Comparator3 Or .f5e = Comparator3) Then

txtCounter(49) = txtCounter(49) + 1

If Not .EOF Then   'combo NEXT DAY
.Edit
.fldprev = Comparator
.Update
.MoveNext
On Error GoTo wrapitup

'txtCounter(.d3na) = txtCounter(.d3na) + 1   'Daily 3 Night predictor
'txtCounter(.d3nb) = txtCounter(.d3nb) + 1   'Daily 3 Night predictor
'txtCounter(.d3nc) = txtCounter(.d3nc) + 1   'Daily 3 Night predictor

'txtCounter(.d4a) = txtCounter(.d4a) + 1   'Daily 4 predictor
'txtCounter(.d4b) = txtCounter(.d4b) + 1   'Daily 4 predictor
'txtCounter(.d4c) = txtCounter(.d4c) + 1   'Daily 4 predictor
'txtCounter(.d4d) = txtCounter(.d4d) + 1   'Daily 4 predictor

'txtCounter(.dda) = txtCounter(.dda) + 1   'Daily Derby predictor
'txtCounter(.DDB) = txtCounter(.DDB) + 1   'Daily Derby predictor
'txtCounter(.DDc) = txtCounter(.DDc) + 1   'Daily Derby predictor
'txtCounter(.ddd) = txtCounter(.ddd) + 1   'Daily Derby predictor
'txtCounter(.dde) = txtCounter(.dde) + 1   'Daily Derby predictor
'txtCounter(.ddf) = txtCounter(.ddf) + 1   'Daily Derby predictor
'.MoveNext
'txtCounter(.dda) = txtCounter(.dda) + 1   'Daily Derby predictor
'txtCounter(.DDB) = txtCounter(.DDB) + 1   'Daily Derby predictor
'txtCounter(.DDc) = txtCounter(.DDc) + 1   'Daily Derby predictor
'txtCounter(.ddd) = txtCounter(.ddd) + 1   'Daily Derby predictor
'txtCounter(.dde) = txtCounter(.dde) + 1   'Daily Derby predictor
'txtCounter(.ddf) = txtCounter(.ddf) + 1   'Daily Derby predictor

txtCounter(.f5a) = txtCounter(.f5a) + 1   'F5 predictor
txtCounter(.f5B) = txtCounter(.f5B) + 1   'F5 predictor
txtCounter(.f5c) = txtCounter(.f5c) + 1   'F5 predictor
txtCounter(.f5d) = txtCounter(.f5d) + 1   'F5 predictor
txtCounter(.f5e) = txtCounter(.f5e) + 1   'F5 predictor
.MoveNext
txtCounter(.f5a) = txtCounter(.f5a) + 1   'F5 predictor
txtCounter(.f5B) = txtCounter(.f5B) + 1   'F5 predictor
txtCounter(.f5c) = txtCounter(.f5c) + 1   'F5 predictor
txtCounter(.f5d) = txtCounter(.f5d) + 1   'F5 predictor
txtCounter(.f5e) = txtCounter(.f5e) + 1   'F5 predictor

.Move -1
End If

Else

.MoveNext

End If

Wend
End With
wrapitup:
rstTEMPY.Close

End Sub

Private Sub ComboSD_Click()

Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\combo\combo.mdb")
Set rstTEMPY = dbs.OpenRecordset("combo")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 55
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank

.Update
.MoveNext
Wend
End If

cvara = 5
cvarb = 3
cvarc = 1
cvard = 1111
cvare = 1111
cvarf = 1111

.MoveFirst
.Move 365

While Not .EOF

If .DDc = 7 Then

'If .d3da = cvara Then
'If .d3db = cvarb Then 'predicted A of daily derby
'If .d3dc = cvarc Then 'predicted 2 of the fantasy 5's

'If .d3da = cvara And .d3db = cvarb Then  'predicted B of daily derby, 'kind of predicted C of daily derby
'If .d3da = cvara And .d3dc = cvarc Then
'If .d3db = cvarb And .d3dc = cvarc Then
'If .d3da = cvara And .d3db = cvarb And .d3dc = cvarc Then

'If .d3da = cvara Or .d3db = cvarb Then 'kind of predicted A of daily derby
'If .d3da = cvara Or .d3dc = cvarc Then
'If .d3db = cvarb Or .d3dc = cvarc Then  'kind of predicted B of daily derby
'If .d3da = cvara Or .d3db = cvarb Or .d3dc = cvarc Then 'kind of predicted B of daily derby

txtCounter(49) = txtCounter(49) + 1

If Not .EOF Then
.Edit
.fldprev = Comparator
.Update
On Error GoTo wrapitup

'txtCounter(.d3na) = txtCounter(.d3na) + 1   'Daily 3 Night predictor
'txtCounter(.d3nb) = txtCounter(.d3nb) + 1   'Daily 3 Night predictor
'txtCounter(.d3nc) = txtCounter(.d3nc) + 1   'Daily 3 Night predictor

'txtCounter(.d4a) = txtCounter(.d4a) + 1   'Daily 4 predictor
'txtCounter(.d4b) = txtCounter(.d4b) + 1   'Daily 4 predictor
'txtCounter(.d4c) = txtCounter(.d4c) + 1   'Daily 4 predictor
'txtCounter(.d4d) = txtCounter(.d4d) + 1   'Daily 4 predictor

'txtCounter(.dda) = txtCounter(.dda) + 1   'Daily Derby predictor
'txtCounter(.DDB) = txtCounter(.DDB) + 1   'Daily Derby predictor
'txtCounter(.DDc) = txtCounter(.DDc) + 1   'Daily Derby predictor
txtCounter(.ddd) = txtCounter(.ddd) + 1   'Daily Derby predictor
'txtCounter(.dde) = txtCounter(.dde) + 1   'Daily Derby predictor
'txtCounter(.ddf) = txtCounter(.ddf) + 1   'Daily Derby predictor

'txtCounter(.f5a) = txtCounter(.f5a) + 1   'F5 predictor
'txtCounter(.f5b) = txtCounter(.f5b) + 1   'F5 predictor
'txtCounter(.f5c) = txtCounter(.f5c) + 1   'F5 predictor
'txtCounter(.f5d) = txtCounter(.f5d) + 1   'F5 predictor
'txtCounter(.f5e) = txtCounter(.f5e) + 1   'F5 predictor

.MoveNext
End If

Else

.MoveNext

End If

Wend
End With
wrapitup:
rstTEMPY.Close

End Sub

Private Sub Command1_Click() 'F5 predictor

' ab, ac, cd

Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\combo\combo.mdb")
Set rstTEMPY = dbs.OpenRecordset("combo")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 55
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank

.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 2377

'binary processes

While Not .EOF

.Edit
GoTo zork

'binary totals process

vc = 0 'varcomp
.fldAbin = 0
.fldBbin = 0
.fldCbin = 0
.fldDbin = 0
.fldEbin = 0

vc = .flda
If vc = 1 Or vc = 2 Or vc = 4 Or vc = 8 Or vc = 16 Or vc = 32 Then
.fldAbin = 1
End If
If vc = 3 Or vc = 5 Or vc = 6 Or vc = 9 Or vc = 10 Or vc = 12 Or vc = 17 Or vc = 18 Or vc = 20 Or vc = 24 Or vc = 33 Or vc = 34 Or vc = 36 Then
.fldAbin = 2
End If
If vc = 7 Or vc = 11 Or vc = 13 Or vc = 14 Or vc = 19 Or vc = 21 Or vc = 22 Or vc = 25 Or vc = 26 Or vc = 28 Or vc = 35 Or vc = 37 Or vc = 38 Then
.fldAbin = 3
End If
If vc = 15 Or vc = 23 Or vc = 27 Or vc = 29 Or vc = 30 Or vc = 39 Then
.fldAbin = 4
End If
If vc = 31 Then
.fldAbin = 5
End If

vc = .fldb
If vc = 1 Or vc = 2 Or vc = 4 Or vc = 8 Or vc = 16 Or vc = 32 Then
.fldBbin = 1
End If
If vc = 3 Or vc = 5 Or vc = 6 Or vc = 9 Or vc = 10 Or vc = 12 Or vc = 17 Or vc = 18 Or vc = 20 Or vc = 24 Or vc = 33 Or vc = 34 Or vc = 36 Then
.fldBbin = 2
End If
If vc = 7 Or vc = 11 Or vc = 13 Or vc = 14 Or vc = 19 Or vc = 21 Or vc = 22 Or vc = 25 Or vc = 26 Or vc = 28 Or vc = 35 Or vc = 37 Or vc = 38 Then
.fldBbin = 3
End If
If vc = 15 Or vc = 23 Or vc = 27 Or vc = 29 Or vc = 30 Or vc = 39 Then
.fldBbin = 4
End If
If vc = 31 Then
.fldBbin = 5
End If

vc = .fldc
If vc = 1 Or vc = 2 Or vc = 4 Or vc = 8 Or vc = 16 Or vc = 32 Then
.fldCbin = 1
End If
If vc = 3 Or vc = 5 Or vc = 6 Or vc = 9 Or vc = 10 Or vc = 12 Or vc = 17 Or vc = 18 Or vc = 20 Or vc = 24 Or vc = 33 Or vc = 34 Or vc = 36 Then
.fldCbin = 2
End If
If vc = 7 Or vc = 11 Or vc = 13 Or vc = 14 Or vc = 19 Or vc = 21 Or vc = 22 Or vc = 25 Or vc = 26 Or vc = 28 Or vc = 35 Or vc = 37 Or vc = 38 Then
.fldCbin = 3
End If
If vc = 15 Or vc = 23 Or vc = 27 Or vc = 29 Or vc = 30 Or vc = 39 Then
.fldCbin = 4
End If
If vc = 31 Then
.fldCbin = 5
End If

vc = .fldd
If vc = 1 Or vc = 2 Or vc = 4 Or vc = 8 Or vc = 16 Or vc = 32 Then
.fldDbin = 1
End If
If vc = 3 Or vc = 5 Or vc = 6 Or vc = 9 Or vc = 10 Or vc = 12 Or vc = 17 Or vc = 18 Or vc = 20 Or vc = 24 Or vc = 33 Or vc = 34 Or vc = 36 Then
.fldDbin = 2
End If
If vc = 7 Or vc = 11 Or vc = 13 Or vc = 14 Or vc = 19 Or vc = 21 Or vc = 22 Or vc = 25 Or vc = 26 Or vc = 28 Or vc = 35 Or vc = 37 Or vc = 38 Then
.fldDbin = 3
End If
If vc = 15 Or vc = 23 Or vc = 27 Or vc = 29 Or vc = 30 Or vc = 39 Then
.fldDbin = 4
End If
If vc = 31 Then
.fldDbin = 5
End If

vc = .flde
If vc = 1 Or vc = 2 Or vc = 4 Or vc = 8 Or vc = 16 Or vc = 32 Then
.fldEbin = 1
End If
If vc = 3 Or vc = 5 Or vc = 6 Or vc = 9 Or vc = 10 Or vc = 12 Or vc = 17 Or vc = 18 Or vc = 20 Or vc = 24 Or vc = 33 Or vc = 34 Or vc = 36 Then
.fldEbin = 2
End If
If vc = 7 Or vc = 11 Or vc = 13 Or vc = 14 Or vc = 19 Or vc = 21 Or vc = 22 Or vc = 25 Or vc = 26 Or vc = 28 Or vc = 35 Or vc = 37 Or vc = 38 Then
.fldEbin = 3
End If
If vc = 15 Or vc = 23 Or vc = 27 Or vc = 29 Or vc = 30 Or vc = 39 Then
.fldEbin = 4
End If
If vc = 31 Then
.fldEbin = 5
End If

.flagbin1 = Null
If .fldAbin = 1 Or .fldBbin = 1 Or .fldCbin = 1 Or .fldDbin = 1 Or .fldEbin = 1 Then
.flagbin1 = 1
End If

.flagbin2 = Null
If .fldAbin = 2 Or .fldBbin = 2 Or .fldCbin = 2 Or .fldDbin = 2 Or .fldEbin = 2 Then
.flagbin2 = 2
End If

.flagbin3 = Null
If .fldAbin = 3 Or .fldBbin = 3 Or .fldCbin = 3 Or .fldDbin = 3 Or .fldEbin = 3 Then
.flagbin3 = 3
End If

.flagbin4 = Null
If .fldAbin = 4 Or .fldBbin = 4 Or .fldCbin = 4 Or .fldDbin = 4 Or .fldEbin = 4 Then
.flagbin4 = 4
End If

.flagbin5 = Null
If .fldAbin = 5 Or .fldBbin = 5 Or .fldCbin = 5 Or .fldDbin = 5 Or .fldEbin = 5 Then
.flagbin5 = 5
End If

.flagbin = Null
If .flagbin1 = 1 Or .flagbin4 = 4 Or .flagbin5 = 5 Then
.flagbin = 99
End If

.fldbintotal = .fldAbin + .fldBbin + .fldCbin + .fldDbin + .fldEbin

'end binary totals process
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
'binary positional process

vc = 0 'varcomp
.fldAbinpos = 0
.fldBbinpos = 0
.fldCbinpos = 0
.fldDbinpos = 0
.fldEbinpos = 0

'If vc = 1 Or vc = 6 Or vc = 7 Or vc = 10 Or vc = 11 Or vc = 12 Or vc = 13 Or vc = 18 Or vc = 19 Or vc = 21 Or vc = 36 Or vc = 37 Then
'vc = 1 Or vc = 3 Or vc = 9 Or vc = 27

'If vc <> 20 And vc <> 21 And vc <> 22 And vc <> 23 And vc <> 24 And vc <> 25 And vc <> 26 And vc <> 27 And vc <> 28 And vc <> 29 And vc <> 30 And vc <> 31 Then
'If vc < 20 And vc > 31 Then

vc = .flda
If vc < 8 Or vc > 23 Then
'If (vc > 8 And vc < 18) Or (vc > 35 And vc < 40) Then
'If vc = 1 Or vc = 4 Or vc = 7 Or vc = 10 Or vc = 13 Or vc = 16 Or vc = 19 Or vc = 22 Or vc = 25 Or vc = 28 Or vc = 31 Or vc = 34 Or vc = 37 Then
.fldAbinpos = 1
End If

vc = .fldb
If vc < 8 Or vc > 23 Then
'If (vc > 8 And vc < 18) Or (vc > 35 And vc < 40) Then
'If vc = 1 Or vc = 4 Or vc = 7 Or vc = 10 Or vc = 13 Or vc = 16 Or vc = 19 Or vc = 22 Or vc = 25 Or vc = 28 Or vc = 31 Or vc = 34 Or vc = 37 Then
.fldBbinpos = 1
End If

vc = .fldc
If vc < 8 Or vc > 23 Then
'If (vc > 8 And vc < 18) Or (vc > 35 And vc < 40) Then
'If vc = 1 Or vc = 4 Or vc = 7 Or vc = 10 Or vc = 13 Or vc = 16 Or vc = 19 Or vc = 22 Or vc = 25 Or vc = 28 Or vc = 31 Or vc = 34 Or vc = 37 Then
.fldCbinpos = 1
End If

vc = .fldd
If vc < 8 Or vc > 23 Then
'If (vc > 8 And vc < 18) Or (vc > 35 And vc < 40) Then
'If vc = 1 Or vc = 4 Or vc = 7 Or vc = 10 Or vc = 13 Or vc = 16 Or vc = 19 Or vc = 22 Or vc = 25 Or vc = 28 Or vc = 31 Or vc = 34 Or vc = 37 Then
.fldDbinpos = 1
End If

vc = .flde
If vc < 8 Or vc > 23 Then
'If (vc > 8 And vc < 18) Or (vc > 35 And vc < 40) Then
'If vc = 1 Or vc = 4 Or vc = 7 Or vc = 10 Or vc = 13 Or vc = 16 Or vc = 19 Or vc = 22 Or vc = 25 Or vc = 28 Or vc = 31 Or vc = 34 Or vc = 37 Then
.fldEbinpos = 1
End If

.flagbinpos = Null
.fldbinpostotal = 0
.fldbinpostotal = .fldAbinpos + .fldBbinpos + .fldCbinpos + .fldDbinpos + .fldEbinpos
'If .fldAbinpos = 1 Or .fldBbinpos = 1 Or .fldCbinpos = 1 Or .fldDbinpos = 1 Or .fldEbinpos = 1 Then
If .fldbinpostotal = 5 Then
.flagbinpos = 99
End If

'end binary positional process

.Update

.MoveNext
Wend
'End If

'END BINARY PROCESS
zork:

.MoveFirst

'.Move 365 * 3

While Not .EOF
'If True Then

'If .p5 > 0 Then
'txtCounter(50) = txtCounter(50) + 1
'End If

'If .p5 < 1 Then
'txtCounter(51) = txtCounter(51) + 1
'End If

'If True Then

'If .p1 > 0 And .p4 = 0 And .p5 = 0 Then

'If (.fldb = .flda + 1) And .flde = .fldd + 10 Then

'If .p1 + .p2 + .p3 + .p4 + .p5 > 0 Then

'If .fldd = .fldc + 4 And .fldc = .fldb + 4 Then

'If .fldc = .fldb * 2 Then

'If .flde - .fldc = 5 Then
'If .fldc = 26 And .flde = 33 Then   '
'If True Then
'If .fldc = 18 Or .fldc = 19 Or .fldc = 23 Or .fldc = 24 Then

'If .fldc = 7 Then
'If .flde = 35 Then

'If (.flda < 16 Or .flda > 24) And (.fldb < 16 Or .fldb > 24) And (.fldc < 16 Or .fldc > 24) And (.fldd < 16 Or .fldd > 24) And (.flde < 16 Or .flde > 24) Then

'If (.fldc = .fldb + 1 And .fldb = .flda + 1) Or (.fldd = .fldc + 1 And .fldc = .fldb + 1) Or (.flde = .fldd + 1 And .fldd = .fldc + 1) Then

'If .flde = .flda + .fldd Then

'If True Then

'If (.flagbinpos = 99) Then
'S = 2

'If .flde - .flda = S Then

'If ((.fldb - .flda = S) Or (.fldc - .flda = S) Or (.fldd - .flda = S) Or (.flde - .flda = S)) Or ((.fldc - .fldb = S) Or (.fldd - .fldb = S) Or (.flde - .fldb = S)) Or ((.fldd - .fldc = S) Or (.flde - .fldc = S)) Or ((.flde - .fldd = S)) Then

'If .flde < 31 Then

'If .flda > 9 And .flde < 22 Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3 Or .fldd = Comparator3 Or .flde = Comparator3) Then

'If .flda + .fldb + .fldc + .fldd + .flde = 88 Then '#(\$)

'If .flda > 8 And .flde < 31 Then

'If (.flde = .flda + .fldc) Then
'If .fldc = 32 Then  '#
'If .flda + .fldc = 30 Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 40 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
txtCounter(49) = txtCounter(49) + 1

If .flagbinpos = 99 Then
txtCounter(48) = txtCounter(48) + 1
End If

'While TheLoop < 2 And Not .EOF
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
'.fldcalc1 = .flda + .fldb + .fldc + .fldd + .flde
.Update
On Error GoTo wrapitup
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
txtCounter(.fldd) = txtCounter(.fldd) + 1
txtCounter(.flde) = txtCounter(.flde) + 1
.MoveNext  'loopy
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
txtCounter(.fldd) = txtCounter(.fldd) + 1
txtCounter(.flde) = txtCounter(.flde) + 1
.MoveNext  'loopy
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
txtCounter(.fldd) = txtCounter(.fldd) + 1
txtCounter(.flde) = txtCounter(.flde) + 1
.Move -2

'TheLoop = TheLoop + 1
End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
Else
.MoveNext
End If
Wend
End With
wrapitup:
rstTEMPY.Close

End Sub

Private Sub cmdD3_Click()

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("placebo")

Me.Refresh

If EraseYN Then
ai = 0
While ai < 41
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator2
txtCN2 = Comparator3

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = 0
.Update
.MoveNext
Wend
End If

.MoveFirst

While Not .EOF
'If .flda = Comparator Then
'If .fldb = Comparator Then
If .fldc = Comparator Then
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
.Update
txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
'txtCounter(.fldc) = txtCounter(.fldc) + 1
End If
Else
.MoveNext
End If

Wend
End With

rstTEMPY.Close

End Sub

Private Sub cmdD3pred_Click() 'D3 predictor Dim TheLoop As Integer Set dbs = OpenDatabase("d:\F5\F5.mdb") Set rstTEMPY = dbs.OpenRecordset("D3") Me.Refresh If InputEraseYN = "y" Then EraseYN = True Else EraseYN = False End If If EraseYN Then ai = 0 While ai < 48 txtCounter(ai) = 0 ai = ai + 1 Wend End If txtCN = Comparator txtCN2 = Comparator2  txtCN2 = Comparator3 With rstTEMPY .MoveFirst If EraseYN Then While Not .EOF .Edit .fldprev = blank .Update .MoveNext Wend End If .MoveFirst While Not .EOF 'If Not True Then 'If .flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Then 'If .flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Then 'If .fldc = Comparator Then If (.flda = 7 And .fldb = 1) Then           'If .flda = .fldb Then '# 'If .flda < .fldb Then '# 'If .flda > .fldb Then '#7 'If .flda = .fldc Then '# 'If .flda < .fldc Then '# 'If .flda > .fldc Then '# 'If .fldb = .fldc Then '# 'If .fldb < .fldc Then '#0 'If .fldb > .fldc Then '# 'If .flda + .fldb = 11 Then '# 'If .flda + .fldb < .fldc Then '# 'If .flda + .fldb = .fldc Then '# 'If .flda + .fldb > .fldc Then '#0 'If .flda + .fldc = 13 Then '#7 'If .flda + .fldc < .fldb Then '# 'If .flda + .fldc = .fldb Then '# 'If .flda + .fldc > .fldb Then '# 'If .fldb + .fldc = 8 Then '# 'If .fldb + .fldc < .flda Then '# 'If .fldb + .fldc = .flda Then '#8 'If .fldb + .fldc > .flda Then '# 'If .flda + .fldb + .fldc = 16 Then '#0 'If .flda = 8 And (.flda + .fldb + .fldc = 16) And (.flda + .fldb > .fldc) And (.flda + .fldc > .fldb) And (.fldb + .fldc = .flda) Then '#1,8 'If .flda = .fldb + .fldc Then '#8 'TheLoop = 1 'While Not .EOF .MoveNext If Not .EOF Then .Edit .fldprev = Comparator .Update txtCounter(.flda) = txtCounter(.flda) + 1 txtCounter(.fldb) = txtCounter(.fldb) + 1 txtCounter(.fldc) = txtCounter(.fldc) + 1 .MoveNext txtCounter(.flda) = txtCounter(.flda) + 1 txtCounter(.fldb) = txtCounter(.fldb) + 1 txtCounter(.fldc) = txtCounter(.fldc) + 1 .MovePrevious txtCounter(47) = txtCounter(47) + 1 'TheLoop = TheLoop + 1 End If 'Wend 'If Not .EOF Then ' .Move 1 'End If Else .MoveNext End If Wend End With rstTEMPY.Close End Sub

Private Sub cmdDDTA_Click()
Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("DD2006")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 60
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator2
txtCN2 = Comparator3

With rstTEMPY
.MoveFirst
If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 2000
While Not .EOF
'If .flda = Comparator Then
'If .flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Then
If .fldb = 12 Then
'TheLoop = 4
'While TheLoop < 5 And Not .EOF
'.Move 1
'If Not .EOF Then
.Edit
.fldprev = Comparator
.Update
'txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
'txtCounter(.fldf) = txtCounter(.fldf) + 1

TheLoop = TheLoop + 1
'End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
Else
'.MoveNext
End If
.MoveNext
Wend
End With

rstTEMPY.Close
End Sub

Private Sub cmdSLP_Click()
Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("SLP2007")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 59
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
'.fldcalc1 = blank
'.fldcalc2 = blank
'.fldcalc3 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 2377

While Not .EOF

'If True Then

If .fldBN = Comparator Then

'If .flde = 41 Then   'And .flde = 41

'If .fldb - .flda = .fldc - .fldb Then

'If (.flda > 14) And (.flde < 38) And ((.fldb = .flda + 1) Or (.fldc = .fldb + 1) Or (.fldd = .fldc + 1) Or (.flde = .fldd + 1)) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3 Or .fldd = Comparator3 Or .flde = Comparator3) Then

'If .flda + .fldb + .fldc + .fldd + .flde = 130 Then '#(\$)

'If (.flda < 20) And (.fldb < 20) And (.fldc < 20) And (.fldd < 20) And (.flde < 20) Then
'If .flda = 2 Then  '#
'If .flda + .fldc = 30 Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 51 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
'While TheLoop < 2 And Not .EOF

'SeqCompVar = .flda
'.MoveNext
'If .flda = SeqCompVar Then
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
'.fldcalc1 = .flda + .fldb + .fldc + .fldd + .flde
.Update
txtCounter(.fldBN) = txtCounter(.fldBN) + 1
'txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
'txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
txtCounter(59) = txtCounter(59) + 1

'TheLoop = TheLoop + 1
End If
.Move -1
'End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
.MoveNext
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close

End Sub

Private Sub cmdSLPTA_Click() Dim TheLoop As Integer Set dbs = OpenDatabase("d:\F5\F5.mdb") Set rstTEMPY = dbs.OpenRecordset("SLP2005") Me.Refresh If InputEraseYN = "y" Then EraseYN = True Else EraseYN = False End If If EraseYN Then ai = 0 While ai < 48 txtCounter(ai) = 0 ai = ai + 1 Wend End If txtCN = Comparator txtCN2 = Comparator2 txtCN2 = Comparator3 With rstTEMPY .MoveFirst If EraseYN Then While Not .EOF .Edit .fldprev = blank .Update .MoveNext Wend End If .MoveFirst '.Move 2000 While Not .EOF If .flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator Then 'If .flda = 10 And .flde = 47 Then 'TheLoop = 4 'While TheLoop < 5 And Not .EOF '.Move 1 'If Not .EOF Then .Edit .fldprev = Comparator .Update 'txtCounter(.fldBN) = txtCounter(.fldBN) + 1 txtCounter(.flda) = txtCounter(.flda) + 1 txtCounter(.fldb) = txtCounter(.fldb) + 1 txtCounter(.fldc) = txtCounter(.fldc) + 1 txtCounter(.fldd) = txtCounter(.fldd) + 1 txtCounter(.flde) = txtCounter(.flde) + 1 TheLoop = TheLoop + 1 'End If 'Wend 'If Not .EOF Then ' .Move 1 'End If Else '.MoveNext End If .MoveNext Wend End With rstTEMPY.Close End Sub

Private Sub cmdSuper_Click()

Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("placebo")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 49
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator2
txtCN2 = Comparator3

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
.Update
.MoveNext
Wend
End If

.MoveFirst

While Not .EOF
If .flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator Then
'If .fldm = Comparator Then
.MoveNext
If Not .EOF Then ' And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) Then
TheLoop = 1
txtCounter(48) = txtCounter(48) + 1
While TheLoop < 2 And Not .EOF
'.Move 1
If Not .EOF Then
.Edit
.fldprev = Comparator
.Update
'txtCounter(.fldm) = txtCounter(.fldm) + 1

txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
txtCounter(.fldd) = txtCounter(.fldd) + 1
txtCounter(.flde) = txtCounter(.flde) + 1
TheLoop = TheLoop + 1
End If
Wend
End If
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close

End Sub

Private Sub Command10_Click()
Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("MM")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 60
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
'.fldcalc1 = blank
'.fldcalc2 = blank
'.fldcalc3 = blank
'.fldtrack39 = blank
'.fldtrack4 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 2377

.MoveNext
While Not .EOF

'If True Then

If .fldBN = Comparator Then

'If .fldc > 47 Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3 Or .fldd = Comparator3 Or .flde = Comparator3) Then

'If .flda + .fldb + .fldc + .fldd + .flde = 161 Then '#(\$)

'If (.fldc = .fldb * 2) And (.fldb = .flda * 2) Then
'If .flda = 9 Then '#
'If .flda + .fldc = 30 Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 40 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
txtCounter(59) = txtCounter(59) + 1
'While TheLoop < 2 And Not .EOF
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
.fldcalc1 = .flda + .fldb + .fldc + .fldd + .flde
.Update
txtCounter(.fldBN) = txtCounter(.fldBN) + 1
'txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
'txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
.MoveNext
txtCounter(.fldBN) = txtCounter(.fldBN) + 1
.Edit
.fldprev = Comparator
.fldcalc1 = .flda + .fldb + .fldc + .fldd + .flde
.Update
'txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
'txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
.MoveNext
txtCounter(.fldBN) = txtCounter(.fldBN) + 1
.Edit
.fldprev = Comparator
.fldcalc1 = .flda + .fldb + .fldc + .fldd + .flde
.Update
'txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
'txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
'TheLoop = TheLoop + 1
'.MoveNext

End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close

End Sub

Private Sub Command11_Click()
Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("DT2005")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 48
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
.fldcalc1 = blank
.fldcalc2 = blank
.fldcalc3 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 2377

While Not .EOF

'If True Then

'If (.fldb = .fldc) And .flda = .fldb * 2 Then

'If (.fldc = .flda - 1) Then

'If .fldc = (.fldb * .fldb) + 1 Then

'If (.fldb = .fldc + 1) Or (.fldb = .fldc - 1) Then

'If (.flda = 2) And (.fldb = 1) And (.fldc = 1) Then

'If .flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2) And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3) Then

If .flda + .fldb + .fldc = 4 Then '#(\$) very promising!

'If (.flda < 20) And (.fldb < 20) And (.fldc < 20) And (.fldd < 20) And (.flde < 20) Then
'If .flda = 2 Then  '#
'If .flda - .fldb = .fldb - .fldc Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 51 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
txtCounter(47) = txtCounter(47) + 1
'While TheLoop < 2 And Not .EOF
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
.fldcalc1 = .flda + .fldb + .fldc
.Update
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
'TheLoop = TheLoop + 1
End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
'.MoveNext
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close
End Sub

Private Sub Command6_Click() 'F5 tag along

Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\combo\combo2010.mdb")
Set rstTEMPY = dbs.OpenRecordset("ff")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 48
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator2
txtCN2 = Comparator3

With rstTEMPY
.MoveFirst
If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 2000
While Not .EOF
'If .fldc = 18 Or .fldc = 19 Or .fldc = 23 Or .fldc = 24 Then

If .f5a = Comparator Or .f5B = Comparator Or .f5c = Comparator Or .f5d = Comparator Or .f5e = Comparator Then
'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) Then
'If True Then

'If .flda = 4 And .fldb = 18 Then
'TheLoop = 4
'While TheLoop < 5 And Not .EOF
'.Move 1
'If Not .EOF Then
.Edit
.fldprev = Comparator
.Update
txtCounter(.f5a) = txtCounter(.f5a) + 1
txtCounter(.f5B) = txtCounter(.f5B) + 1
txtCounter(.f5c) = txtCounter(.f5c) + 1
txtCounter(.f5d) = txtCounter(.f5d) + 1
txtCounter(.f5e) = txtCounter(.f5e) + 1
TheLoop = TheLoop + 1
'End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
Else
'.MoveNext
End If
.MoveNext
Wend
End With

rstTEMPY.Close
End Sub

Private Sub Command7_Click() 'F5 seq predictor

Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("placebo")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 48
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator2
txtCN2 = Comparator3

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
.fldtrack39 = blank
.fldtrack4 = blank
.fldcalc1 = blank
.fldcalc2 = blank
.fldcalc3 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst

While Not .EOF
If .flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator Then

If Not .EOF Then
.MoveNext
End If
On Error Resume Next
If Not .EOF And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) Then
.MoveNext
If Not .EOF And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3 Or .fldd = Comparator3 Or .flde = Comparator3) Then
TheLoop = 1
txtCounter(47) = txtCounter(47) + 1
While TheLoop < 2 And Not .EOF
.Move 1
If Not .EOF Then
.Edit
.fldprev = Comparator
.Update
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
txtCounter(.fldd) = txtCounter(.fldd) + 1
txtCounter(.flde) = txtCounter(.flde) + 1
TheLoop = TheLoop + 1
End If
Wend
End If
End If
Else
If Not .EOF Then
.MoveNext
End If
End If
Wend
End With

rstTEMPY.Close

End Sub

Private Sub Command8_Click() 'D3 Seq Pred
Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("D3")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 48
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator2
txtCN2 = Comparator3

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
'.fldcalc1 = blank
'.fldcalc2 = blank
'.fldcalc3 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst

While Not .EOF
'If .flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Then
'If .flda = Comparator Or .flda = Comparator2 Or .flda = Comparator3 Or .flda = Comparator4 Then
If .fldc = Comparator Or .fldc = Comparator2 Or .fldc = Comparator3 Or .fldc = Comparator4 Then
'.MoveNext
'On Error Resume Next
'If Not .EOF And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2) Then
'If Not .EOF And (.flda = Comparator Or .flda = Comparator2 Or .flda = Comparator3 Or .flda = Comparator4) Then
'If Not .EOF And (.fldc = Comparator Or .fldc = Comparator2 Or .fldc = Comparator3 Or .fldc = Comparator4) Then
'.MoveNext
'If Not .EOF And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3) Then
'If Not .EOF And (.flda = Comparator Or .flda = Comparator2 Or .flda = Comparator3 Or .flda = Comparator4) Then
'If Not .EOF And (.fldc = Comparator Or .fldc = Comparator2 Or .fldc = Comparator3 Or .fldc = Comparator4) Then
'   .MoveNext

'If Not .EOF And (.flda = Comparator4 Or .fldb = Comparator4 Or .fldc = Comparator4) Then
'If Not .EOF And (.flda = Comparator Or .flda = Comparator2 Or .flda = Comparator3 Or .flda = Comparator4) Then
If Not .EOF And (.fldc = Comparator Or .fldc = Comparator2 Or .fldc = Comparator3 Or .fldc = Comparator4) Then
'TheLoop = 1
txtCounter(47) = txtCounter(47) + 1
While Not .EOF
.Move 1
If Not .EOF Then
.Edit
.fldprev = Comparator
.Update
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
TheLoop = TheLoop + 1
End If
Wend
End If
'End If
'End If
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close

End Sub

Private Sub Command9_Click()
Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("placebo")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 48
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
.fldcalc1 = blank
.fldcalc2 = blank
.fldcalc3 = blank
.fldtrack39 = blank
.fldtrack4 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 2000

While Not .EOF
'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) Then

If .flda + .fldb + .fldc = 8 Then   '#(\$) seems to work

'If (.flda + .fldb = 7) And (.fldb + .fldc = 14) Then
'ab and bc doesn't work
'If .flda + .fldb = 28 Then '#
'If .flda + .fldc = 30 Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 51 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
txtCounter(47) = txtCounter(47) + 1
'While TheLoop < 2 And Not .EOF
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
.fldcalc3 = .flda + .fldb + .fldc
.Update
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
'TheLoop = TheLoop + 1
End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close

End Sub

Private Sub D4research_Click()

Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("D3")

Me.Refresh

With rstTEMPY

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 55
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

.MoveFirst

While Not .EOF
'If True Then

'If .p5 > 0 Then
'txtCounter(50) = txtCounter(50) + 1
'End If

'If .p5 < 1 Then
'txtCounter(51) = txtCounter(51) + 1
'End If

'If True Then

'If .p1 > 0 And .p4 = 0 And .p5 = 0 Then

'If (.fldb = .flda + 1) And .flde = .fldd + 10 Then

'If .p1 + .p2 + .p3 + .p4 + .p5 > 0 Then

'If .fldd = .fldc + 4 And .fldc = .fldb + 4 Then

'If .fldc = .fldb * 2 Then

'If .flde - .fldc = 5 Then
'If .fldc = 26 And .flde = 33 Then   '
'If True Then
'If .fldc = 18 Or .fldc = 19 Or .fldc = 23 Or .fldc = 24 Then

'If .fldc = 7 Then
'If .flde = 35 Then

'If (.flda > 10 And .flda < 20) And (.fldb > 20 And .fldd < 30) Then

'If (.fldc = .fldb + 1 And .fldb = .flda + 1) Or (.fldd = .fldc + 1 And .fldc = .fldb + 1) Or (.flde = .fldd + 1 And .fldd = .fldc + 1) Then

'If .flde = .flda + .fldd Then

'If True Then

'If .fldb = 12 And .flde = 24 Then

'If .flda > 10 And .fldd < 20 Then

'If .fldc < 9 And .flde < 33 Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) Then

If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2) And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3) Then

'If .flda + .fldb + .fldc + .fldd + .flde = 88 Then '#(\$)

'If .flda > 8 And .flde < 31 Then

'If (.flde = .flda + .fldc) Then
'If .fldc = 32 Then  '#
'If .flda + .fldc = 30 Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 40 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
txtCounter(49) = txtCounter(49) + 1
'While TheLoop < 2 And Not .EOF
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
.Update
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
.MoveNext  'loopy
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
.MoveNext  'loopy
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
'                 .MoveNext  'loopy
'                txtCounter(.flda) = txtCounter(.flda) + 1
'                txtCounter(.fldb) = txtCounter(.fldb) + 1
'                txtCounter(.fldc) = txtCounter(.fldc) + 1
.Move -2

'TheLoop = TheLoop + 1
End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close
End Sub

Private Sub DD_Click()
Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("DD2006")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 60
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
'.fldcalc1 = blank
'.fldcalc2 = blank
'.fldcalc3 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst

Counter = 1
While Not .EOF

'If True Then
'If Counter < 145 Then
'Counter = Counter + 1

'If (.flda > 7 And .fldb > 7 And .fldc > 7) And (.fldb = .fldd) Then

'If .flda = 1 And .fldd = 5 Then

'If .flda > 6 And .fldb > 6 And .fldc > 6 Then

'If .flda = .fldb + 1 And .fldb = .fldc + 1 Then

'If .fldb = .flde And .fldd = 5 Then  'works to predict flda?

'If .fldb = .fldf * 2 And .flde = 3 Then

'If .fldc = .fldd And .fldb = 2 Then

'If .fldb = 2 And .flde = 5 And .fldd = 3 Then

'If .fldc = .fldd Then

'If .fldb = .flde * 2 Then

'If .fldc = 12 And .fldf = 0 Then

'If (.fldc = .fldf) Then 'predicts #7

'If .flda >= .fldb And .fldb <= .fldc And .fldc >= .fldd And .fldd <= .flde And .flde <= .fldf Then

'If .flda >= .fldb And .fldb <= .fldc And .fldc >= .fldd And .fldd >= .flde And .flde <= .fldf Then

'If .fldc = .flda + .fldb Or .fldf = .fldd + .flde Then

'If .fldb = 2 And .fldf = 8 Then

'If .fldd = 3 Then

'If .fldc = .flde * 2 Then

'If .fldb = 6 And .fldf = 3 Then

'If .flda < 9 And .fldb > 9 And .fldc < 5 Then

'If True Then

'If .flda = .fldb + 1 And .fldb = .fldc + 1 Then

'If .flda > 9 And .fldc > 9 And .fldb < 10 Then

'If .fldc = .fldf / 2 Then

'If .fldc = .fldd + .fldf Then

'If .flda - .fldb = .flde Then

'If (.flda <> .fldb And .flda <> .fldc And .flda <> .fldd And .flda <> .flde And .flda <> .fldf And .fldb <> .fldc And .fldb <> .fldd And .fldb <> .flde And .fldb <> .fldf And .fldc <> .fldd And .fldc <> .flde And .fldc <> .fldf And .fldd <> .flde And .fldd <> .fldf And .flde <> .fldf) Then   'And (.fldd = .flda * .flda)

'If (.flda = .fldb * 2) And (.fldb = .fldc * 2) Then

'If True Then

'If .fldc = .fldd Then

'If (.flda = .fldd - .fldb) And (.flde = .fldd - .fldb) Then

'If .flda * .flda = .fldc Then

'If (.fldb = .fldc + 1) Or (.fldb = .fldc - 1) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2) Then

'If (.fldc = 3) Then

'If (.flda > 6 And .flda < 10) And (.fldb > 6 And .fldb < 10) And (.fldc > 6 And .fldc < 10) Then

'If (.flda = 4) And (.fldd = Comparator Or .flde = Comparator Or .fldf = Comparator) Then

'If .flda = 4 And (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) Then

'If (.fldd = Comparator Or .flde = Comparator Or .fldf = Comparator) And (.fldd = Comparator2 Or .flde = Comparator2 Or .fldf = Comparator2) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator Or .fldf = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2 Or .fldf = Comparator2) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2) And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3) Then

If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) And (.fldd = Comparator Or .flde = Comparator Or .fldf = Comparator) Then

'If .flda + .fldb + .fldc = 30 Then '#(\$) very promising!

'If (.flda < 20) And (.fldb < 20) And (.fldc < 20) And (.fldd < 20) And (.flde < 20) Then
'If .flda = 2 Then  '#
'If .flda - .fldb = .fldb - .fldc Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 51 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
txtCounter(47) = txtCounter(47) + 1
'While TheLoop < 2 And Not .EOF
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
'.fldcalc1 = .flda + .fldb + .fldc
.Update
On Error GoTo wrapitup
'txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
'txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
txtCounter(.fldf) = txtCounter(.fldf) + 1
.MoveNext
'txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
'txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
txtCounter(.fldf) = txtCounter(.fldf) + 1
.MoveNext
'txtCounter(.flda) = txtCounter(.flda) + 1
'txtCounter(.fldb) = txtCounter(.fldb) + 1
'txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
txtCounter(.fldf) = txtCounter(.fldf) + 1
.Move -2
'TheLoop = TheLoop + 1
End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
'.MoveNext
Else
.MoveNext
End If
Wend
End With
wrapitup:
rstTEMPY.Close

End Sub

Private Sub DDsums_Click()
Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("placebo")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 48
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
.fldcalc1 = blank
.fldcalc2 = blank
.fldcalc3 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 2000

While Not .EOF
'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator Or .fldd = Comparator Or .flde = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2 Or .fldd = Comparator2 Or .flde = Comparator2) Then

If .fldc = 12 And .flda + .fldb + .fldc = 21 Then  '#(\$) seems to work

'If (.flda + .fldb = 7) And (.fldb + .fldc = 14) Then
'ab and bc doesn't work
'If .flda + .fldb = 28 Then '#
'If .flda + .fldc = 30 Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 51 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
txtCounter(47) = txtCounter(47) + 1
'While TheLoop < 2 And Not .EOF
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
.fldcalc3 = .flda + .fldb + .fldc
.Update
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
'txtCounter(.fldd) = txtCounter(.fldd) + 1
'txtCounter(.flde) = txtCounter(.flde) + 1
'TheLoop = TheLoop + 1
End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close
End Sub

Private Sub DT2005_Click()

Dim TheLoop As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("DT2005")

Me.Refresh

If InputEraseYN = "y" Then
EraseYN = True
Else
EraseYN = False
End If

If EraseYN Then
ai = 0
While ai < 48
txtCounter(ai) = 0
ai = ai + 1
Wend
End If

txtCN = Comparator
txtCN2 = Comparator

With rstTEMPY
.MoveFirst

If EraseYN Then
While Not .EOF
.Edit
.fldprev = blank
.fldcalc1 = blank
.fldcalc2 = blank
.fldcalc3 = blank
.Update
.MoveNext
Wend
End If

.MoveFirst
'.Move 1071

While Not .EOF

'If True Then

'If ((.flda = .fldb) Or (.flda = .fldc) Or (.fldb = .fldc)) And (.flda = 5) Then

'If (.flda + .fldc = 13) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) Then

'If (.flda = Comparator Or .fldb = Comparator Or .fldc = Comparator) And (.flda = Comparator2 Or .fldb = Comparator2 Or .fldc = Comparator2) And (.flda = Comparator3 Or .fldb = Comparator3 Or .fldc = Comparator3) Then

If .flda + .fldb + .fldc = 9 Then '#(\$)

'If (.flda < 20) And (.fldb < 20) And (.fldc < 20) And (.fldd < 20) And (.flde < 20) Then
'If .fldc = Comparator Then  '#
'If .flda + .fldc = 30 Then '#
'If .flda + .fldd = 22 Then '#13
'If .flda + .flde = 51 Then '#

'If .fldb + .fldc = 34 Then '#(\$)
'If .fldb + .fldd = 40 Then '#
'If .fldb + .flde = 41 Then '#

'If .fldc + .fldd = 37 Then
'If .fldc + .flde = 43 Then '#

'If .fldd + .flde = 44 Then '#

'If .flda + .fldb + .fldc = 46 Then '#
'If .flda + .fldb + .fldd = 47 Then '(\$)#
'If .flda + .fldb + .flde = 36 Then '#(\$)14,15,17

'If .fldb + .fldc + .fldd = 53 Then '#
'If .fldb + .fldc + .flde = 59 Then '#

'If .fldc + .fldd + .flde = 58 Then '#20

'-If .fldb + .fldc = 17 And .fldb + .fldc + .flde = 55 Then '#
'-If .fldb + .flde = .flda + .fldb + .fldd Then '#
'-If .flda + .fldb + .flde = .fldb + .fldc + .fldd Then '#
'-If .fldtrack39 = 888 Then

'TheLoop = 1
txtCounter(47) = txtCounter(47) + 1
'While TheLoop < 2 And Not .EOF
.MoveNext
If Not .EOF Then
.Edit
.fldprev = Comparator
.fldcalc1 = .flda + .fldb + .fldc
.Update
txtCounter(.flda) = txtCounter(.flda) + 1
txtCounter(.fldb) = txtCounter(.fldb) + 1
txtCounter(.fldc) = txtCounter(.fldc) + 1
'TheLoop = TheLoop + 1
End If
'Wend
'If Not .EOF Then
'    .Move 1
'End If
'End If
Else
.MoveNext
End If
Wend
End With

rstTEMPY.Close

End Sub

Private Sub DTsort_Click()

Dim TheLoop As Integer

Dim TS As Integer

Set dbs = OpenDatabase("d:\F5\F5.mdb")
Set rstTEMPY = dbs.OpenRecordset("DTsortproject")

Me.Refresh

With rstTEMPY
.MoveFirst

While Not .EOF

.Edit

If .flda > .fldb Then
TS = .flda
.flda = .fldb
.fldb = TS
End If

If .fldb > .fldc Then
TS = .fldb
.fldb = .fldc
.fldc = TS
End If

If .flda > .fldb Then
TS = .flda
.flda = .fldb
.fldb = TS
End If

.Update

.MoveNext

Wend
End With

rstTEMPY.Close
End Sub

Private Sub F5sort_Click()
Dim TheLoop As Integer

Dim TS As Integer

Set dbs = OpenDatabase("d:\combo\combo2010.mdb")
Set rstTEMPY = dbs.OpenRecordset("ff")

Me.Refresh

With rstTEMPY
.MoveFirst
.Move 1180

While Not .EOF

.Edit

If .f5a > .f5B Then
TS = .f5a
.f5a = .f5B
.f5B = TS
End If

If .f5B > .f5c Then
TS = .f5B
.f5B = .f5c
.f5c = TS
End If

If .f5c > .f5d Then
TS = .f5c
.f5c = .f5d
.f5d = TS
End If

If .f5d > .f5e Then
TS = .f5d
.f5d = .f5e
.f5e = TS
End If

.Update

.MoveNext

Wend
End With

rstTEMPY.Close
End Sub

- End of Article -

Re: Using Mobile?
Home: site intro and featured articles/resources.
View Web Version: displays Main Menu article categories (will be located below), additional site info (below and side), search function, translation function.