Visual Basic 4 / 5 / 6 RSS Visual Basic 4 / 5 / 6 RSS

Visual Basic coding for excel database - am tearing my hair out!

Reply

•
•
Join Date: Oct 2007
Posts: 1
Reputation: jonwildman is an unknown quantity at this point 
Solved Threads: 0
jonwildman jonwildman is offline Offline
Newbie Poster

Visual Basic coding for excel database - am tearing my hair out!

 
0
  #1
Oct 25th, 2007
Visual Basic coding for excel database - am tearing my hair out!



I am trying to build a database in Excel 2002 / Windows XP.
I have 5 columns starting from row B they are as follows..
TITLE/ PUBLISHER / YEAR OF PUBLICATION /DATA TYPE /ELECTRONIC /HARDCOPY

/DESCRIPTION /WEB LOCATION/NETWORK LOCATION /HARDCOPY LOCATION

/CYCLING/WALKING/ACCESSIBILITY



This picture best illiustrates what the spreadsheet looks like..

When I click on the start button it brings up a form. This form is for

people to populate the sheet with data and to search. It is the search

function I am having problems with.

When there are multiple results for the publciation title, you have to

click FIND ALL to view them. Problem is it only diaplays the TITLE /

PUBLISHER/ YEAR OF PUBLICATION / and DATA TYPE values. Furthermore it has

problems displaying correct values for the check boxes.
I need it to display values for all fields, accurately. If there are

multiple results, clicking on the relevant record in the listbox and then

clicking SELECT should result in switching between records on the fly with

the correct results being displayed.

Second problem isnt so much a problem, but an enhancement. Instead of

having to click on the FIND ALL button when there are multple results, I

would like the results to be displayed automatically in the list box

without user intervention. How so?


The code is here:

Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text) 
  1.  
  2. Option Explicit
  3. Dim MyArray(6, 6)
  4. Public MyData As Range, c As Range
  5.  
  6. Private Sub CheckBox1_Click()
  7.  
  8. End Sub
  9.  
  10. Private Sub CheckBox2_Click()
  11.  
  12. End Sub
  13.  
  14. Private Sub Clearbutton_Click()
  15.         Me.TextBox1.Value = vbNullString
  16.         Me.TextBox2.Value = vbNullString
  17.         Me.TextBox3.Value = vbNullString
  18.         Me.TextBox4.Value = vbNullString
  19.         Me.CheckBox1.Value = vbNullString
  20.         Me.CheckBox2.Value = vbNullString
  21.         Me.txtDesc.Value = vbNullString
  22.         Me.txtLocate.Value = vbNullString
  23.         Me.txtLocate2.Value = vbNullString
  24.         Me.txtLocate3.Value = vbNullString
  25.         Me.OptionButton1.Value = vbNullString
  26.         Me.OptionButton2.Value = vbNullString
  27.         Me.OptionButton3.Value = vbNullString
  28. End Sub
  29.  
  30. Private Sub cmbAdd_Click()
  31. 'next empty cell in column A
  32.     Set c = Range("b65536").End(xlUp).Offset(1, 0)
  33.     Application.ScreenUpdating = False    'speed up, hide task
  34.     'write userform entries to database
  35.     c.Value = Me.TextBox1.Value
  36.     c.Offset(0, 1).Value = Me.TextBox2.Value
  37.     c.Offset(0, 2).Value = Me.TextBox3.Value
  38.     c.Offset(0, 3).Value = Me.TextBox4.Value
  39.     c.Offset(0, 4).Value = Me.CheckBox1.Value
  40.     c.Offset(0, 5).Value = Me.CheckBox2.Value
  41.     c.Offset(0, 6).Value = Me.txtDesc.Value
  42.     c.Offset(0, 7).Value = Me.txtLocate.Value
  43.     c.Offset(0, 8).Value = Me.txtLocate2.Value
  44.     c.Offset(0, 9).Value = Me.txtLocate3.Value
  45.     c.Offset(0, 10).Value = Me.OptionButton1.Value
  46.     c.Offset(0, 11).Value = Me.OptionButton2.Value
  47.     c.Offset(0, 12).Value = Me.OptionButton3.Value
  48.     'clear the form
  49.     With Me
  50.         .TextBox1.Value = vbNullString
  51.         .TextBox2.Value = vbNullString
  52.         .TextBox3.Value = vbNullString
  53.         .TextBox4.Value = vbNullString
  54.         .CheckBox1.Value = vbNullString
  55.         .CheckBox2.Value = vbNullString
  56.         .txtDesc.Value = vbNullString
  57.         .txtLocate.Value = vbNullString
  58.         .txtLocate2.Value = vbNullString
  59.         .txtLocate3.Value = vbNullString
  60.         .OptionButton1.Value = vbNullString
  61.         .OptionButton2.Value = vbNullString
  62.         .OptionButton3.Value = vbNullString
  63.     End With
  64.     Application.ScreenUpdating = True
  65. End Sub
  66.  
  67. Private Sub cmbDelete_Click()
  68.     Dim msgResponse As String    'confirm delete
  69.     Application.ScreenUpdating = False
  70.     'get user confirmation
  71.     msgResponse = MsgBox("This will delete the selected record. Continue?", 
  72.  
  73. _
  74.                          vbCritical + vbYesNo, "Delete Entry")
  75.     Select Case msgResponse    'action dependent on response
  76.     Case vbYes
  77.         'c has been selected by Find button
  78.         Set c = ActiveCell
  79.         c.EntireRow.Delete    'remove entry by deleting row
  80.         'restore form settings
  81.         With Me
  82.             .cmbAmend.Enabled = False     'prevent accidental use
  83.             .cmbDelete.Enabled = False    'prevent accidental use
  84.             .cmbAdd.Enabled = True        'restore use
  85.             'clear form
  86.             .TextBox1.Value = vbNullString
  87.             .TextBox2.Value = vbNullString
  88.             .TextBox3.Value = vbNullString
  89.             .TextBox4.Value = vbNullString
  90.             .CheckBox1.Value = vbNullString
  91.             .CheckBox2.Value = vbNullString
  92.             .txtDesc.Value = vbNullString
  93.             .txtLocate.Value = vbNullString
  94.             .txtLocate2.Value = vbNullString
  95.             .txtLocate3.Value = vbNullString
  96.             .OptionButton1.Value = vbNullString
  97.             .OptionButton2.Value = vbNullString
  98.             .OptionButton3.Value = vbNullString
  99.         End With
  100.     Case vbNo
  101.         Exit Sub    'cancelled
  102.     End Select
  103.     Application.ScreenUpdating = True
  104. End Sub
  105.  
  106. Private Sub cmbFind_Click()
  107.     Dim strFind, FirstAddress As String   'what to find
  108.     Dim rSearch As Range  'range to search
  109.     Set rSearch = Sheet1.Range("b6", Range("b65536").End(xlUp))
  110.     strFind = Me.TextBox1.Value    'what to look for
  111.     Dim f As Integer
  112.     With rSearch
  113.         Set c = .Find(strFind, LookIn:=xlValues)
  114.         If Not c Is Nothing Then    'found it
  115.             c.Select
  116.             With Me    'load entry to form
  117.                 .TextBox2.Value = c.Offset(0, 1).Value
  118.                 .TextBox3.Value = c.Offset(0, 2).Value
  119.                 .TextBox4.Value = c.Offset(0, 3).Value
  120.                 .CheckBox1.Value = c.Offset(0, 4).Value
  121.                 .CheckBox2.Value = c.Offset(0, 5).Value
  122.                 .txtDesc.Value = c.Offset(0, 6).Value
  123.                 .txtLocate.Value = c.Offset(0, 7).Value
  124.                 .txtLocate2.Value = c.Offset(0, 8).Value
  125.                 .txtLocate3.Value = c.Offset(0, 9).Value
  126.                 .OptionButton1.Value = c.Offset(0, 10).Value
  127.                 .OptionButton2.Value = c.Offset(0, 11).Value
  128.                 .OptionButton3.Value = c.Offset(0, 12).Value
  129.                 .cmbAmend.Enabled = True     'allow amendment or
  130.                 .cmbDelete.Enabled = True    'allow record deletion
  131.                 .cmbAdd.Enabled = False      'don't want to duplicate 
  132.  
  133. record
  134.                 f = 0
  135.             End With
  136.             FirstAddress = c.Address
  137.             Do
  138.                 f = f + 1    'count number of matching records
  139.                 Set c = .FindNext(c)
  140.             Loop While Not c Is Nothing And c.Address <> FirstAddress
  141.             If f > 1 Then
  142.                 MsgBox "There are " & f & " instances of " & strFind
  143.                 Me.Height = 589
  144.             End If
  145.         Else: MsgBox strFind & " not listed"    'search failed
  146.         End If
  147.     End With
  148. End Sub
  149.  
  150. Private Sub cmbAmend_Click()
  151.  
  152.     Application.ScreenUpdating = False
  153.     Set c = ActiveCell                   ' c selected by Find
  154.     c.Value = Me.TextBox1.Value          ' write amendments to database
  155.     c.Offset(0, 1).Value = Me.TextBox2.Value
  156.     c.Offset(0, 2).Value = Me.TextBox3.Value
  157.     c.Offset(0, 3).Value = Me.TextBox4.Value
  158.     c.Offset(0, 4).Value = Me.CheckBox1.Value
  159.     c.Offset(0, 5).Value = Me.CheckBox2.Value
  160.     c.Offset(0, 6).Value = Me.txtDesc.Value
  161.     c.Offset(0, 7).Value = Me.txtLocate.Value
  162.     c.Offset(0, 8).Value = Me.txtLocate2.Value
  163.     c.Offset(0, 9).Value = Me.txtLocate3.Value
  164.     c.Offset(0, 10).Value = Me.OptionButton1.Value
  165.     c.Offset(0, 11).Value = Me.OptionButton2.Value
  166.     c.Offset(0, 12).Value = Me.OptionButton3.Value
  167.     'restore Form
  168.     With Me
  169.         .cmbAmend.Enabled = False
  170.         .cmbDelete.Enabled = False
  171.         .cmbAdd.Enabled = True
  172.         .TextBox1.Value = vbNullString
  173.         .TextBox2.Value = vbNullString
  174.         .TextBox3.Value = vbNullString
  175.         .TextBox4.Value = vbNullString
  176.         .CheckBox1.Value = vbNullString
  177.         .CheckBox2.Value = vbNullString
  178.         .txtDesc.Value = vbNullString
  179.         .txtLocate.Value = vbNullString
  180.         .txtLocate2.Value = vbNullString
  181.         .txtLocate3.Value = vbNullString
  182.         .OptionButton1.Value = vbNullString
  183.         .OptionButton2.Value = vbNullString
  184.         .OptionButton3.Value = vbNullString
  185.     End With
  186.     Application.ScreenUpdating = True
  187. End Sub
  188.  
  189. Private Sub cmbFindAll_Click()
  190.     Dim FirstAddress As String
  191.     Dim strFind As String    'what to find
  192.     Dim rSearch As Range     'range to search
  193.     Dim fndA, fndB, fndC, fndD As String
  194.     Dim head1, head2, head3, head4, head5 As String    'heading s for list
  195.     Dim i As Integer
  196.     i = 1
  197.     Set rSearch = Sheet1.Range("b6", Range("b65536").End(xlUp))
  198.     strFind = Me.TextBox1.Value
  199.     With rSearch
  200.         Set c = .Find(strFind, LookIn:=xlValues)
  201.         If Not c Is Nothing Then    'found it
  202.             c.Select
  203.             'load the headings
  204.             head1 = Range("b5").Value
  205.             head2 = Range("c5").Value
  206.             head3 = Range("d5").Value
  207.             head4 = Range("e5").Value
  208.             head4 = Range("f5").Value
  209.             head4 = Range("g5").Value
  210.             head5 = Range("g5").Value
  211.             With Me.ListBox1
  212.                 MyArray(0, 0) = head1
  213.                 MyArray(0, 1) = head2
  214.                 MyArray(0, 2) = head3
  215.                 MyArray(0, 3) = head4
  216.                 MyArray(0, 4) = head5
  217.  
  218.             End With
  219.             FirstAddress = c.Address
  220.             Do
  221.                 'Load details into Listbox
  222.                 fndA = c.Value
  223.                 fndB = c.Offset(0, 1).Value
  224.                 fndC = c.Offset(0, 2).Value
  225.                 fndD = c.Offset(0, 3).Value
  226.  'here
  227.  
  228.                 MyArray(i, 0) = fndA
  229.                 MyArray(i, 1) = fndB
  230.                 MyArray(i, 2) = fndC
  231.                 MyArray(i, 3) = fndD
  232.  
  233.  
  234.  
  235.                 i = i + 1
  236.                 Set c = .FindNext(c)
  237.             Loop While Not c Is Nothing And c.Address <> FirstAddress
  238.  
  239.         End If
  240.     End With
  241.     'Load data into LISTBOX
  242.     Me.ListBox1.List() = MyArray
  243.  
  244. End Sub
  245.  
  246. Private Sub cmbLast_Click()
  247.     Dim LastCl As Range
  248.     Set LastCl = Range("b65536").End(xlUp)    'last used cell in column A
  249.     With Me
  250.         .cmbAmend.Enabled = False
  251.         .cmbDelete.Enabled = False
  252.         .cmbAdd.Enabled = True
  253.         .TextBox1.Value = LastCl.Value
  254.         .TextBox2.Value = LastCl.Offset(0, 1).Value
  255.         .TextBox3.Value = LastCl.Offset(0, 2).Value
  256.         .TextBox4.Value = LastCl.Offset(0, 3).Value
  257.         .CheckBox1.Value = LastCl.Offset(0, 4).Value
  258.         .CheckBox2.Value = LastCl.Offset(0, 5).Value
  259.         .txtDesc.Value = LastCl.Offset(0, 6).Value
  260.         .txtLocate.Value = LastCl.Offset(0, 7).Value
  261.         .txtLocate2.Value = LastCl.Offset(0, 8).Value
  262.         .txtLocate3.Value = LastCl.Offset(0, 9).Value
  263.         .OptionButton1.Value = LastCl.Offset(0, 10).Value
  264.         .OptionButton2.Value = LastCl.Offset(0, 11).Value
  265.         .OptionButton3.Value = LastCl.Offset(0, 12).Value
  266.     End With
  267. End Sub
  268.  
  269. Private Sub cmbSelect_Click()
  270.     Dim r As Integer
  271.     If Me.ListBox1.ListIndex = -1 Then    'not selected
  272.         MsgBox " No selection made"
  273.     ElseIf Me.ListBox1.ListIndex >= 0 Then    'User has selected
  274.         r = Me.ListBox1.ListIndex
  275.  
  276.         With Me
  277.             .TextBox1.Value = ListBox1.List(r, 0)
  278.             .TextBox2.Value = ListBox1.List(r, 1)
  279.             .TextBox3.Value = ListBox1.List(r, 2)
  280.             .TextBox4.Value = ListBox1.List(r, 3)
  281.             .CheckBox1.Value = c.Offset(0, 4).Value
  282.             .CheckBox2.Value = c.Offset(0, 5).Value
  283.             .OptionButton1.Value = c.Offset(0, 10).Value
  284.             .OptionButton2.Value = c.Offset(0, 11).Value
  285.             .OptionButton3.Value = c.Offset(0, 12).Value
  286.  
  287.          'CONTINUE HERE
  288.  
  289.             .cmbAmend.Enabled = True      'allow amendment or
  290.             .cmbDelete.Enabled = True     'allow record deletion
  291.             .cmbAdd.Enabled = False       'don't want duplicate
  292.         End With
  293.  
  294.  
  295.     End If
  296. End Sub
  297.  
  298. Private Sub cmnbFirst_Click()
  299.     Dim FirstCl As Range
  300.  
  301.     'first data Entry
  302.     Set FirstCl = Range("b1").End(xlDown).Offset(1, 0) 'allow for rows 
  303.  
  304. being added deleted above header row
  305.  
  306.     With Me
  307.         .cmbAmend.Enabled = False
  308.         .cmbDelete.Enabled = False
  309.         .cmbAdd.Enabled = True
  310.         .TextBox1.Value = FirstCl.Value
  311.         .TextBox2.Value = FirstCl.Offset(0, 1).Value
  312.         .TextBox3.Value = FirstCl.Offset(0, 2).Value
  313.         .TextBox4.Value = FirstCl.Offset(0, 3).Value
  314.         .CheckBox1.Value = FirstCl.Offset(0, 4).Value
  315.         .CheckBox2.Value = FirstCl.Offset(0, 5).Value
  316.         .txtDesc.Value = FirstCl.Offset(0, 6).Value
  317.         .txtLocate.Value = FirstCl.Offset(0, 7).Value
  318.         .txtLocate2.Value = FirstCl.Offset(0, 8).Value
  319.         .txtLocate3.Value = FirstCl.Offset(0, 9).Value
  320.         .OptionButton1.Value = FirstCl.Offset(0, 10).Value
  321.         .OptionButton2.Value = FirstCl.Offset(0, 11).Value
  322.         .OptionButton3.Value = FirstCl.Offset(0, 12).Value
  323.     End With
  324. End Sub
  325.  
  326.  
  327.  
  328. Private Sub ComboBoxCat_Change()
  329.  
  330. End Sub
  331.  
  332. Private Sub ComboBoxFormat_Change()
  333.  
  334. End Sub
  335.  
  336. Private Sub Frame1_Click()
  337.  
  338. End Sub
  339.  
  340. Private Sub Frame4_Click()
  341.  
  342. End Sub
  343.  
  344. Private Sub Label1_Click()
  345.  
  346. End Sub
  347.  
  348. Private Sub Label2_Click()
  349.  
  350. End Sub
  351.  
  352. Private Sub Label8_Click()
  353.  
  354. End Sub
  355.  
  356. Private Sub ListBox1_Click()
  357.  
  358. End Sub
  359.  
  360. Private Sub OptionButton3_Click()
  361.  
  362. End Sub
  363.  
  364. Private Sub TextBox1_Change()
  365.  
  366. End Sub
  367.  
  368. Private Sub TextBox4_Change()
  369.  
  370. End Sub
  371.  
  372. Private Sub txtDesc_Change()
  373.  
  374. End Sub
  375.  
  376. Private Sub UserForm_Initialize()
  377.     Set MyData = Sheet1.Range("b5").CurrentRegion   'database
  378.     With Me
  379.         .Caption = "CWA Articles & Publications Database"    'userform 
  380.  
  381. caption
  382.     End With
  383. TextBox4.List = Array("Report", "Study", "Leaflet", "Presentation")
  384. End Sub
Last edited by jonwildman; Oct 25th, 2007 at 8:32 am.
Reply With Quote Quick reply to this message  
•
•
Join Date: Oct 2007
Posts: 20
Reputation: Diguelo is an unknown quantity at this point 
Solved Threads: 1
Diguelo Diguelo is offline Offline
Newbie Poster

Re: Visual Basic coding for excel database - am tearing my hair out!

 
0
  #2
Oct 27th, 2007
Without seeing the form, Im guessing textboxes 1 to 4 display the info?

I love a challenge, email me if you need help. diguelo@aol.com
Half the problems in the computer world are caused by the Seat to Keyboard Interface.
Reply With Quote Quick reply to this message  
•
•
Join Date: Oct 2007
Posts: 147
Reputation: hopalongcassidy is an unknown quantity at this point 
Solved Threads: 13
hopalongcassidy's Avatar
hopalongcassidy hopalongcassidy is offline Offline
Junior Poster

Re: Visual Basic coding for excel database - am tearing my hair out!

 
0
  #3
Oct 27th, 2007
Sorry to have to break the news to you. The code you posted is totally unusable. It has to be rewritten by someone who knows how to program. Even if you get the code to work perfectly, the code is unmaintainable. If you don't believe me, just try coming back to the code in six months and trying to figure out what ".TextBox3.Value = FirstCl.Offset(0, 2).Value" means. I guaranty that you will throw your hands up in the air and scream. You are already doing that and you haven't even got the first version working yet.

I also think that your choice to use Excel as a database was a poor one. While it is possible to do that, Excel was not designed for that purpose. It lacks the methodology that allows you to do, with a single instruction, what requires dozens of instructions using the Visual Basic instruction set in Excel. That is not to say that you cannot end up with your data in Excel.

If you wish to discuss this further with me, please send me a "private message" by clicking on my name (next to the picture of Hopalong Cassidy) above.

Sincerely,

Hoppy
Last edited by hopalongcassidy; Oct 27th, 2007 at 1:53 pm.
Reply With Quote Quick reply to this message  
Reply

Quick Reply to Thread
This thread is more than three months old.
Perhaps start a new thread instead?
•
•
•
•
•
•
•
•
Message:
•
•
•
•



Similar Threads
Other Threads in the Visual Basic 4 / 5 / 6 Forum
Thread Tools Search this Thread



* 6 429 2007 access activex add age application basic beginner birth bmp calculator cd cells.find click client code college component connection connectionproblemusingvb6usingoledb copy creat ctrl+f data database datareport date delete dissertations dissertationthesis dissertationtopic edit error excel excelmacro file filename form hardware header iamthwee image inboxinvb internetfiledownload keypress label listbox listview liveperson login looping machine microsoft movingranges number objectinsert open oracle password prime program prompt range-objects readfile reading record refresh remotesqlserverdatabase report save search sendbyte sites sort sql sql2008 sqlserver subroutine tags textbox time urldownloadtofile vb vb6 vb6.0 vba visual visualbasic visualbasic6 web window windows
About Us | Contact Us | Advertise | DaniWeb | Acceptable Use Policy | RSS Feed

©2003 - 2009 DaniWeb® LLC