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

Expand Post »

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)
 
Option Explicit
Dim MyArray(6, 6)
Public MyData As Range, c As Range
 
Private Sub CheckBox1_Click()
 
End Sub
 
Private Sub CheckBox2_Click()
 
End Sub
 
Private Sub Clearbutton_Click()
        Me.TextBox1.Value = vbNullString
        Me.TextBox2.Value = vbNullString
        Me.TextBox3.Value = vbNullString
        Me.TextBox4.Value = vbNullString
        Me.CheckBox1.Value = vbNullString
        Me.CheckBox2.Value = vbNullString
        Me.txtDesc.Value = vbNullString
        Me.txtLocate.Value = vbNullString
        Me.txtLocate2.Value = vbNullString
        Me.txtLocate3.Value = vbNullString
        Me.OptionButton1.Value = vbNullString
        Me.OptionButton2.Value = vbNullString
        Me.OptionButton3.Value = vbNullString
End Sub
 
Private Sub cmbAdd_Click()
'next empty cell in column A
    Set c = Range("b65536").End(xlUp).Offset(1, 0)
    Application.ScreenUpdating = False    'speed up, hide task
    'write userform entries to database
    c.Value = Me.TextBox1.Value
    c.Offset(0, 1).Value = Me.TextBox2.Value
    c.Offset(0, 2).Value = Me.TextBox3.Value
    c.Offset(0, 3).Value = Me.TextBox4.Value
    c.Offset(0, 4).Value = Me.CheckBox1.Value
    c.Offset(0, 5).Value = Me.CheckBox2.Value
    c.Offset(0, 6).Value = Me.txtDesc.Value
    c.Offset(0, 7).Value = Me.txtLocate.Value
    c.Offset(0, 8).Value = Me.txtLocate2.Value
    c.Offset(0, 9).Value = Me.txtLocate3.Value
    c.Offset(0, 10).Value = Me.OptionButton1.Value
    c.Offset(0, 11).Value = Me.OptionButton2.Value
    c.Offset(0, 12).Value = Me.OptionButton3.Value
    'clear the form
    With Me
        .TextBox1.Value = vbNullString
        .TextBox2.Value = vbNullString
        .TextBox3.Value = vbNullString
        .TextBox4.Value = vbNullString
        .CheckBox1.Value = vbNullString
        .CheckBox2.Value = vbNullString
        .txtDesc.Value = vbNullString
        .txtLocate.Value = vbNullString
        .txtLocate2.Value = vbNullString
        .txtLocate3.Value = vbNullString
        .OptionButton1.Value = vbNullString
        .OptionButton2.Value = vbNullString
        .OptionButton3.Value = vbNullString
    End With
    Application.ScreenUpdating = True
End Sub
 
Private Sub cmbDelete_Click()
    Dim msgResponse As String    'confirm delete
    Application.ScreenUpdating = False
    'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", 
 
_
                         vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse    'action dependent on response
    Case vbYes
        'c has been selected by Find button
        Set c = ActiveCell
        c.EntireRow.Delete    'remove entry by deleting row
        'restore form settings
        With Me
            .cmbAmend.Enabled = False     'prevent accidental use
            .cmbDelete.Enabled = False    'prevent accidental use
            .cmbAdd.Enabled = True        'restore use
            'clear form
            .TextBox1.Value = vbNullString
            .TextBox2.Value = vbNullString
            .TextBox3.Value = vbNullString
            .TextBox4.Value = vbNullString
            .CheckBox1.Value = vbNullString
            .CheckBox2.Value = vbNullString
            .txtDesc.Value = vbNullString
            .txtLocate.Value = vbNullString
            .txtLocate2.Value = vbNullString
            .txtLocate3.Value = vbNullString
            .OptionButton1.Value = vbNullString
            .OptionButton2.Value = vbNullString
            .OptionButton3.Value = vbNullString
        End With
    Case vbNo
        Exit Sub    'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub
 
Private Sub cmbFind_Click()
    Dim strFind, FirstAddress As String   'what to find
    Dim rSearch As Range  'range to search
    Set rSearch = Sheet1.Range("b6", Range("b65536").End(xlUp))
    strFind = Me.TextBox1.Value    'what to look for
    Dim f As Integer
    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            With Me    'load entry to form
                .TextBox2.Value = c.Offset(0, 1).Value
                .TextBox3.Value = c.Offset(0, 2).Value
                .TextBox4.Value = c.Offset(0, 3).Value
                .CheckBox1.Value = c.Offset(0, 4).Value
                .CheckBox2.Value = c.Offset(0, 5).Value
                .txtDesc.Value = c.Offset(0, 6).Value
                .txtLocate.Value = c.Offset(0, 7).Value
                .txtLocate2.Value = c.Offset(0, 8).Value
                .txtLocate3.Value = c.Offset(0, 9).Value
                .OptionButton1.Value = c.Offset(0, 10).Value
                .OptionButton2.Value = c.Offset(0, 11).Value
                .OptionButton3.Value = c.Offset(0, 12).Value
                .cmbAmend.Enabled = True     'allow amendment or
                .cmbDelete.Enabled = True    'allow record deletion
                .cmbAdd.Enabled = False      'don't want to duplicate 
 
record
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1    'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                MsgBox "There are " & f & " instances of " & strFind
                Me.Height = 589
            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With
End Sub
 
Private Sub cmbAmend_Click()
 
    Application.ScreenUpdating = False
    Set c = ActiveCell                   ' c selected by Find
    c.Value = Me.TextBox1.Value          ' write amendments to database
    c.Offset(0, 1).Value = Me.TextBox2.Value
    c.Offset(0, 2).Value = Me.TextBox3.Value
    c.Offset(0, 3).Value = Me.TextBox4.Value
    c.Offset(0, 4).Value = Me.CheckBox1.Value
    c.Offset(0, 5).Value = Me.CheckBox2.Value
    c.Offset(0, 6).Value = Me.txtDesc.Value
    c.Offset(0, 7).Value = Me.txtLocate.Value
    c.Offset(0, 8).Value = Me.txtLocate2.Value
    c.Offset(0, 9).Value = Me.txtLocate3.Value
    c.Offset(0, 10).Value = Me.OptionButton1.Value
    c.Offset(0, 11).Value = Me.OptionButton2.Value
    c.Offset(0, 12).Value = Me.OptionButton3.Value
    'restore Form
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = vbNullString
        .TextBox2.Value = vbNullString
        .TextBox3.Value = vbNullString
        .TextBox4.Value = vbNullString
        .CheckBox1.Value = vbNullString
        .CheckBox2.Value = vbNullString
        .txtDesc.Value = vbNullString
        .txtLocate.Value = vbNullString
        .txtLocate2.Value = vbNullString
        .txtLocate3.Value = vbNullString
        .OptionButton1.Value = vbNullString
        .OptionButton2.Value = vbNullString
        .OptionButton3.Value = vbNullString
    End With
    Application.ScreenUpdating = True
End Sub
 
Private Sub cmbFindAll_Click()
    Dim FirstAddress As String
    Dim strFind As String    'what to find
    Dim rSearch As Range     'range to search
    Dim fndA, fndB, fndC, fndD As String
    Dim head1, head2, head3, head4, head5 As String    'heading s for list
    Dim i As Integer
    i = 1
    Set rSearch = Sheet1.Range("b6", Range("b65536").End(xlUp))
    strFind = Me.TextBox1.Value
    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            'load the headings
            head1 = Range("b5").Value
            head2 = Range("c5").Value
            head3 = Range("d5").Value
            head4 = Range("e5").Value
            head4 = Range("f5").Value
            head4 = Range("g5").Value
            head5 = Range("g5").Value
            With Me.ListBox1
                MyArray(0, 0) = head1
                MyArray(0, 1) = head2
                MyArray(0, 2) = head3
                MyArray(0, 3) = head4
                MyArray(0, 4) = head5
 
            End With
            FirstAddress = c.Address
            Do
                'Load details into Listbox
                fndA = c.Value
                fndB = c.Offset(0, 1).Value
                fndC = c.Offset(0, 2).Value
                fndD = c.Offset(0, 3).Value
 'here
 
                MyArray(i, 0) = fndA
                MyArray(i, 1) = fndB
                MyArray(i, 2) = fndC
                MyArray(i, 3) = fndD
 
 
 
                i = i + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
 
        End If
    End With
    'Load data into LISTBOX
    Me.ListBox1.List() = MyArray
 
End Sub
 
Private Sub cmbLast_Click()
    Dim LastCl As Range
    Set LastCl = Range("b65536").End(xlUp)    'last used cell in column A
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = LastCl.Value
        .TextBox2.Value = LastCl.Offset(0, 1).Value
        .TextBox3.Value = LastCl.Offset(0, 2).Value
        .TextBox4.Value = LastCl.Offset(0, 3).Value
        .CheckBox1.Value = LastCl.Offset(0, 4).Value
        .CheckBox2.Value = LastCl.Offset(0, 5).Value
        .txtDesc.Value = LastCl.Offset(0, 6).Value
        .txtLocate.Value = LastCl.Offset(0, 7).Value
        .txtLocate2.Value = LastCl.Offset(0, 8).Value
        .txtLocate3.Value = LastCl.Offset(0, 9).Value
        .OptionButton1.Value = LastCl.Offset(0, 10).Value
        .OptionButton2.Value = LastCl.Offset(0, 11).Value
        .OptionButton3.Value = LastCl.Offset(0, 12).Value
    End With
End Sub
 
Private Sub cmbSelect_Click()
    Dim r As Integer
    If Me.ListBox1.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    ElseIf Me.ListBox1.ListIndex >= 0 Then    'User has selected
        r = Me.ListBox1.ListIndex
 
        With Me
            .TextBox1.Value = ListBox1.List(r, 0)
            .TextBox2.Value = ListBox1.List(r, 1)
            .TextBox3.Value = ListBox1.List(r, 2)
            .TextBox4.Value = ListBox1.List(r, 3)
            .CheckBox1.Value = c.Offset(0, 4).Value
            .CheckBox2.Value = c.Offset(0, 5).Value
            .OptionButton1.Value = c.Offset(0, 10).Value
            .OptionButton2.Value = c.Offset(0, 11).Value
            .OptionButton3.Value = c.Offset(0, 12).Value
 
         'CONTINUE HERE
 
            .cmbAmend.Enabled = True      'allow amendment or
            .cmbDelete.Enabled = True     'allow record deletion
            .cmbAdd.Enabled = False       'don't want duplicate
        End With
 
 
    End If
End Sub
 
Private Sub cmnbFirst_Click()
    Dim FirstCl As Range
 
    'first data Entry
    Set FirstCl = Range("b1").End(xlDown).Offset(1, 0) 'allow for rows 
 
being added deleted above header row
 
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = FirstCl.Value
        .TextBox2.Value = FirstCl.Offset(0, 1).Value
        .TextBox3.Value = FirstCl.Offset(0, 2).Value
        .TextBox4.Value = FirstCl.Offset(0, 3).Value
        .CheckBox1.Value = FirstCl.Offset(0, 4).Value
        .CheckBox2.Value = FirstCl.Offset(0, 5).Value
        .txtDesc.Value = FirstCl.Offset(0, 6).Value
        .txtLocate.Value = FirstCl.Offset(0, 7).Value
        .txtLocate2.Value = FirstCl.Offset(0, 8).Value
        .txtLocate3.Value = FirstCl.Offset(0, 9).Value
        .OptionButton1.Value = FirstCl.Offset(0, 10).Value
        .OptionButton2.Value = FirstCl.Offset(0, 11).Value
        .OptionButton3.Value = FirstCl.Offset(0, 12).Value
    End With
End Sub
 
 
 
Private Sub ComboBoxCat_Change()
 
End Sub
 
Private Sub ComboBoxFormat_Change()
 
End Sub
 
Private Sub Frame1_Click()
 
End Sub
 
Private Sub Frame4_Click()
 
End Sub
 
Private Sub Label1_Click()
 
End Sub
 
Private Sub Label2_Click()
 
End Sub
 
Private Sub Label8_Click()
 
End Sub
 
Private Sub ListBox1_Click()
 
End Sub
 
Private Sub OptionButton3_Click()
 
End Sub
 
Private Sub TextBox1_Change()
 
End Sub
 
Private Sub TextBox4_Change()
 
End Sub
 
Private Sub txtDesc_Change()
 
End Sub
 
Private Sub UserForm_Initialize()
    Set MyData = Sheet1.Range("b5").CurrentRegion   'database
    With Me
        .Caption = "CWA Articles & Publications Database"    'userform 
 
caption
    End With
TextBox4.List = Array("Report", "Study", "Leaflet", "Presentation")
End Sub
 
Option Explicit
Dim MyArray(6, 6)
Public MyData As Range, c As Range

Private Sub CheckBox1_Click()

End Sub

Private Sub CheckBox2_Click()

End Sub

Private Sub Clearbutton_Click()
        Me.TextBox1.Value = vbNullString
        Me.TextBox2.Value = vbNullString
        Me.TextBox3.Value = vbNullString
        Me.TextBox4.Value = vbNullString
        Me.CheckBox1.Value = vbNullString
        Me.CheckBox2.Value = vbNullString
        Me.txtDesc.Value = vbNullString
        Me.txtLocate.Value = vbNullString
        Me.txtLocate2.Value = vbNullString
        Me.txtLocate3.Value = vbNullString
        Me.OptionButton1.Value = vbNullString
        Me.OptionButton2.Value = vbNullString
        Me.OptionButton3.Value = vbNullString
End Sub

Private Sub cmbAdd_Click()
'next empty cell in column A
    Set c = Range("b65536").End(xlUp).Offset(1, 0)
    Application.ScreenUpdating = False    'speed up, hide task
    'write userform entries to database
    c.Value = Me.TextBox1.Value
    c.Offset(0, 1).Value = Me.TextBox2.Value
    c.Offset(0, 2).Value = Me.TextBox3.Value
    c.Offset(0, 3).Value = Me.TextBox4.Value
    c.Offset(0, 4).Value = Me.CheckBox1.Value
    c.Offset(0, 5).Value = Me.CheckBox2.Value
    c.Offset(0, 6).Value = Me.txtDesc.Value
    c.Offset(0, 7).Value = Me.txtLocate.Value
    c.Offset(0, 8).Value = Me.txtLocate2.Value
    c.Offset(0, 9).Value = Me.txtLocate3.Value
    c.Offset(0, 10).Value = Me.OptionButton1.Value
    c.Offset(0, 11).Value = Me.OptionButton2.Value
    c.Offset(0, 12).Value = Me.OptionButton3.Value
    'clear the form
    With Me
        .TextBox1.Value = vbNullString
        .TextBox2.Value = vbNullString
        .TextBox3.Value = vbNullString
        .TextBox4.Value = vbNullString
        .CheckBox1.Value = vbNullString
        .CheckBox2.Value = vbNullString
        .txtDesc.Value = vbNullString
        .txtLocate.Value = vbNullString
        .txtLocate2.Value = vbNullString
        .txtLocate3.Value = vbNullString
        .OptionButton1.Value = vbNullString
        .OptionButton2.Value = vbNullString
        .OptionButton3.Value = vbNullString
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub cmbDelete_Click()
    Dim msgResponse As String    'confirm delete
    Application.ScreenUpdating = False
    'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", 

_
                         vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse    'action dependent on response
    Case vbYes
        'c has been selected by Find button
        Set c = ActiveCell
        c.EntireRow.Delete    'remove entry by deleting row
        'restore form settings
        With Me
            .cmbAmend.Enabled = False     'prevent accidental use
            .cmbDelete.Enabled = False    'prevent accidental use
            .cmbAdd.Enabled = True        'restore use
            'clear form
            .TextBox1.Value = vbNullString
            .TextBox2.Value = vbNullString
            .TextBox3.Value = vbNullString
            .TextBox4.Value = vbNullString
            .CheckBox1.Value = vbNullString
            .CheckBox2.Value = vbNullString
            .txtDesc.Value = vbNullString
            .txtLocate.Value = vbNullString
            .txtLocate2.Value = vbNullString
            .txtLocate3.Value = vbNullString
            .OptionButton1.Value = vbNullString
            .OptionButton2.Value = vbNullString
            .OptionButton3.Value = vbNullString
        End With
    Case vbNo
        Exit Sub    'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub

Private Sub cmbFind_Click()
    Dim strFind, FirstAddress As String   'what to find
    Dim rSearch As Range  'range to search
    Set rSearch = Sheet1.Range("b6", Range("b65536").End(xlUp))
    strFind = Me.TextBox1.Value    'what to look for
    Dim f As Integer
    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            With Me    'load entry to form
                .TextBox2.Value = c.Offset(0, 1).Value
                .TextBox3.Value = c.Offset(0, 2).Value
                .TextBox4.Value = c.Offset(0, 3).Value
                .CheckBox1.Value = c.Offset(0, 4).Value
                .CheckBox2.Value = c.Offset(0, 5).Value
                .txtDesc.Value = c.Offset(0, 6).Value
                .txtLocate.Value = c.Offset(0, 7).Value
                .txtLocate2.Value = c.Offset(0, 8).Value
                .txtLocate3.Value = c.Offset(0, 9).Value
                .OptionButton1.Value = c.Offset(0, 10).Value
                .OptionButton2.Value = c.Offset(0, 11).Value
                .OptionButton3.Value = c.Offset(0, 12).Value
                .cmbAmend.Enabled = True     'allow amendment or
                .cmbDelete.Enabled = True    'allow record deletion
                .cmbAdd.Enabled = False      'don't want to duplicate 

record
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1    'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                MsgBox "There are " & f & " instances of " & strFind
                Me.Height = 589
            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With
End Sub

Private Sub cmbAmend_Click()

    Application.ScreenUpdating = False
    Set c = ActiveCell                   ' c selected by Find
    c.Value = Me.TextBox1.Value          ' write amendments to database
    c.Offset(0, 1).Value = Me.TextBox2.Value
    c.Offset(0, 2).Value = Me.TextBox3.Value
    c.Offset(0, 3).Value = Me.TextBox4.Value
    c.Offset(0, 4).Value = Me.CheckBox1.Value
    c.Offset(0, 5).Value = Me.CheckBox2.Value
    c.Offset(0, 6).Value = Me.txtDesc.Value
    c.Offset(0, 7).Value = Me.txtLocate.Value
    c.Offset(0, 8).Value = Me.txtLocate2.Value
    c.Offset(0, 9).Value = Me.txtLocate3.Value
    c.Offset(0, 10).Value = Me.OptionButton1.Value
    c.Offset(0, 11).Value = Me.OptionButton2.Value
    c.Offset(0, 12).Value = Me.OptionButton3.Value
    'restore Form
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = vbNullString
        .TextBox2.Value = vbNullString
        .TextBox3.Value = vbNullString
        .TextBox4.Value = vbNullString
        .CheckBox1.Value = vbNullString
        .CheckBox2.Value = vbNullString
        .txtDesc.Value = vbNullString
        .txtLocate.Value = vbNullString
        .txtLocate2.Value = vbNullString
        .txtLocate3.Value = vbNullString
        .OptionButton1.Value = vbNullString
        .OptionButton2.Value = vbNullString
        .OptionButton3.Value = vbNullString
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub cmbFindAll_Click()
    Dim FirstAddress As String
    Dim strFind As String    'what to find
    Dim rSearch As Range     'range to search
    Dim fndA, fndB, fndC, fndD As String
    Dim head1, head2, head3, head4, head5 As String    'heading s for list
    Dim i As Integer
    i = 1
    Set rSearch = Sheet1.Range("b6", Range("b65536").End(xlUp))
    strFind = Me.TextBox1.Value
    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            'load the headings
            head1 = Range("b5").Value
            head2 = Range("c5").Value
            head3 = Range("d5").Value
            head4 = Range("e5").Value
            head4 = Range("f5").Value
            head4 = Range("g5").Value
            head5 = Range("g5").Value
            With Me.ListBox1
                MyArray(0, 0) = head1
                MyArray(0, 1) = head2
                MyArray(0, 2) = head3
                MyArray(0, 3) = head4
                MyArray(0, 4) = head5
                 
            End With
            FirstAddress = c.Address
            Do
                'Load details into Listbox
                fndA = c.Value
                fndB = c.Offset(0, 1).Value
                fndC = c.Offset(0, 2).Value
                fndD = c.Offset(0, 3).Value
 'here

                MyArray(i, 0) = fndA
                MyArray(i, 1) = fndB
                MyArray(i, 2) = fndC
                MyArray(i, 3) = fndD
               
               
             
                i = i + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress

        End If
    End With
    'Load data into LISTBOX
    Me.ListBox1.List() = MyArray

End Sub

Private Sub cmbLast_Click()
    Dim LastCl As Range
    Set LastCl = Range("b65536").End(xlUp)    'last used cell in column A
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = LastCl.Value
        .TextBox2.Value = LastCl.Offset(0, 1).Value
        .TextBox3.Value = LastCl.Offset(0, 2).Value
        .TextBox4.Value = LastCl.Offset(0, 3).Value
        .CheckBox1.Value = LastCl.Offset(0, 4).Value
        .CheckBox2.Value = LastCl.Offset(0, 5).Value
        .txtDesc.Value = LastCl.Offset(0, 6).Value
        .txtLocate.Value = LastCl.Offset(0, 7).Value
        .txtLocate2.Value = LastCl.Offset(0, 8).Value
        .txtLocate3.Value = LastCl.Offset(0, 9).Value
        .OptionButton1.Value = LastCl.Offset(0, 10).Value
        .OptionButton2.Value = LastCl.Offset(0, 11).Value
        .OptionButton3.Value = LastCl.Offset(0, 12).Value
    End With
End Sub

Private Sub cmbSelect_Click()
    Dim r As Integer
    If Me.ListBox1.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    ElseIf Me.ListBox1.ListIndex >= 0 Then    'User has selected
        r = Me.ListBox1.ListIndex

        With Me
            .TextBox1.Value = ListBox1.List(r, 0)
            .TextBox2.Value = ListBox1.List(r, 1)
            .TextBox3.Value = ListBox1.List(r, 2)
            .TextBox4.Value = ListBox1.List(r, 3)
            .CheckBox1.Value = c.Offset(0, 4).Value
            .CheckBox2.Value = c.Offset(0, 5).Value
            .OptionButton1.Value = c.Offset(0, 10).Value
            .OptionButton2.Value = c.Offset(0, 11).Value
            .OptionButton3.Value = c.Offset(0, 12).Value
        
         'CONTINUE HERE
           
            .cmbAmend.Enabled = True      'allow amendment or
            .cmbDelete.Enabled = True     'allow record deletion
            .cmbAdd.Enabled = False       'don't want duplicate
        End With


    End If
End Sub

Private Sub cmnbFirst_Click()
    Dim FirstCl As Range

    'first data Entry
    Set FirstCl = Range("b1").End(xlDown).Offset(1, 0) 'allow for rows 

being added deleted above header row

    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = FirstCl.Value
        .TextBox2.Value = FirstCl.Offset(0, 1).Value
        .TextBox3.Value = FirstCl.Offset(0, 2).Value
        .TextBox4.Value = FirstCl.Offset(0, 3).Value
        .CheckBox1.Value = FirstCl.Offset(0, 4).Value
        .CheckBox2.Value = FirstCl.Offset(0, 5).Value
        .txtDesc.Value = FirstCl.Offset(0, 6).Value
        .txtLocate.Value = FirstCl.Offset(0, 7).Value
        .txtLocate2.Value = FirstCl.Offset(0, 8).Value
        .txtLocate3.Value = FirstCl.Offset(0, 9).Value
        .OptionButton1.Value = FirstCl.Offset(0, 10).Value
        .OptionButton2.Value = FirstCl.Offset(0, 11).Value
        .OptionButton3.Value = FirstCl.Offset(0, 12).Value
    End With
End Sub

 

Private Sub ComboBoxCat_Change()

End Sub

Private Sub ComboBoxFormat_Change()

End Sub

Private Sub Frame1_Click()

End Sub

Private Sub Frame4_Click()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label2_Click()

End Sub

Private Sub Label8_Click()

End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub OptionButton3_Click()

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub TextBox4_Change()

End Sub

Private Sub txtDesc_Change()

End Sub

Private Sub UserForm_Initialize()
    Set MyData = Sheet1.Range("b5").CurrentRegion   'database
    With Me
        .Caption = "CWA Articles & Publications Database"    'userform 

caption
    End With
TextBox4.List = Array("Report", "Study", "Leaflet", "Presentation")
End Sub

Last edited by jonwildman; Oct 25th, 2007 at 8:32 am.

Similar Threads

Open Excel file from Visual Basic in Visual Basic 4 / 5 / 6
Visual Basic Error on Word and Excel 2003 in Windows NT / 2000 / XP
create pdf from excel etc. visual basic 6.0 in Visual Basic 4 / 5 / 6
Is it possible to display report in Visual Basic which is created in Microsoft Access in Visual Basic 4 / 5 / 6
opening excel file in visual basic 6 in Visual Basic 4 / 5 / 6

jonwildman

Reputation Points: 10

Solved Threads: 0

Newbie Poster

Offline

1 posts
since Oct 2007

Permalink

Oct 27th, 2007

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

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

Diguelo

Reputation Points: 10

Solved Threads: 1

Newbie Poster

Offline

23 posts
since Oct 2007

Permalink

Oct 27th, 2007

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

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.

hopalongcassidy

Reputation Points: 53

Solved Threads: 13

Junior Poster

Offline

148 posts
since Oct 2007

This thread is more than three months old

No one has posted to this discussion for at least three months. Please let old threads die and do not reply to them unless you feel you have something new and valuable to contribute that absolutely must be added to make the discussion complete. Otherwise, please start a new thread in this forum instead.

Previous Thread in Visual Basic 4 / 5 / 6 Forum Timeline: extract columns from a text file in vb

Next Thread in Visual Basic 4 / 5 / 6 Forum Timeline: FlexGridWithCombobox

DaniWeb Message

Cancel Changes

User Name
Password