Database Userform Code Help

matty25

New Member
Joined
Nov 1, 2008
Messages
28
Hello everyone, i'm hoping that someone can help me as well as i hopefully can help others.

I have a small problem trying to figure out the correct vba code on an excel userform. What i'm trying to do? :confused:

Okay, i have an Excel spreadsheet full of data, a supplier database with columns ranging from A (trade) through to L (email address) (and inbetween containing things like contact name, address, company name etc), note 12 columns of data across and potentially infinite rows down as the database grows over time.

I have created frmSearch (userform) which contains TextBox1 and ListBox1 along with two cmdButtons - "Find All", and "Close".

The user fills part text into TextBox1 of the trade which they are looking for, and then clicks Find All. The Trade column (column A) is then searched for matching records. The results of the search are then populated in ListBox1.

I have a couple of problems I need help with please:

1. I need ListBox1 to show all 12 columns but it isn't doing this. I believe it can only show a maximum of 10 (0-9) when using the AddItem command. Is there alternative code to workaround this? (as i need to show all 12!).

2. After pressing Find All button, when the search results are returned in ListBox1 i want to be able to double-click on any of the results for that result to be transferred to a new userform say frmRecord into 12 relevant textboxes. On the bottom of frmRecord will be a button called Copy...

3. I then need a cmdButton to copy the text from the 12 textboxes so that i can use this information in other programs e.g. to paste into word.

4. How would i go about setting up a new userform to view the records, say with 12 textboxes (named after columns A-L) with 3 cmdButtons - one button for "Next Record", one for "Previous Record" and one for "Close" (to close form). The Next and Previous buttons would be used for navigating next and previous records in supplier database.

5. I also need to set up a separate userform to be able to Amend and Delete existing data in the database. I already have a userform setup for Adding new data.

Any help, suggestions, and hopefully solutions will be much appreciated.

Regards,

Matt :confused:
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
1) To fill a 12 column list box, create a 12 column Array and assing the listbox's List property to that array. In the example below, the butFindAll routine calls the function ArrayOfMatchingRows and then sets ListBox1 to show all 12 columns.

2) The double click routine below, fills TextBox1-12 of userform2 with the values of the selected row.

3) The routine butCopy_Click will take the data from 12 textboxes and put it in the Clipboard as a carriage return delimited string.

4,5) I wouldn't add a new userform. I'd add Editing commands to the second userform. You might consider doing this all on one Userform with multi-pages.

in Userform1
Code:
Private Sub butFindAll_Click()
Dim foundArray As Variant
With Me
    foundArray = ArrayOfMatchingRows(.TextBox1.Text)
    With .ListBox1
        .Clear
        If 0 < UBound(foundArray, 1) Then
            .List = foundArray
        End If
    End With
End With
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Static abort As Boolean
    Dim i As Long
    If abort Then abort = False: Exit Sub
    
    With Me.ListBox1
        If -1 < .ListIndex Then
            For i = 0 To 11
                UserForm2.Controls("TextBox" & CStr(i + 1)).Text = .List(.ListIndex, i)
            Next i
            abort = True
            UserForm2.Show
        End If
    End With
End Sub

Function ArrayOfMatchingRows(searchTerm As String) As Variant
    Dim oneCell As Range
    Dim ColumnCount As Long
    Dim DataArray As Variant
    Dim countOfFound As Long, i As Long
    
    ColumnCount = 12
    ReDim DataArray(1 To ColumnCount, 1 To dataRange.Rows.Count)
    
    countOfFound = 0
    For Each oneCell In dataRange().Columns(1).Cells
        If LCase(oneCell.Value) = LCase(searchTerm) Then
            countOfFound = countOfFound + 1
            For i = 1 To ColumnCount
                DataArray(i, countOfFound) = oneCell.Cells(1, i).Value
            Next i
        End If
    Next oneCell
    
    If 0 < countOfFound Then
        ReDim Preserve DataArray(1 To ColumnCount, 1 To countOfFound)
    Else
        ReDim DataArray(0 To 0, 0 To 0)
    End If
    
    ArrayOfMatchingRows = Application.Transpose(DataArray)
End Function

Function dataRange() As Range
    With Sheet1.Range("A:A")
        Set dataRange = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 12)
    End With
End Function
Your post on OzGrid has a header row, so I assumed that in the function dataRange.
In Userform2
Code:
Private Sub butCopy_Click()
    Dim myData As New DataObject
    Dim i As Long, consolidateStr As String
    With Me
        For i = 1 To 12
            consolidateStr = consolidateStr & vbCr & .Controls("TextBox" & i).Text
        Next i
    End With
    consolidateStr = Mid(consolidateStr, 2)

    myData.SetText consolidateStr
    myData.PutInClipboard

    Set myData = Nothing
End Sub
 
Upvote 0
Hi,

I'm also interested in the above and have setup a really quick worksheet (sheet1) and created a basic userform with :

Textbox1
Listbox1
CommandButton1

When i click the command button assigned to butFindAll i get the following error :

Runtime error '13'
type mismatch

the debugged then highlights : ArrayOfMatchingRows = Application.Transpose(DataArray)

In column A i have my Dates, displayed as dd/mm/yyyy (UK format).

Now, if i change the range that the code looks through to D:D which contains a Dealer Code rather than a date then the listbox is then populated but with the data from column D onwards.

So...

1) Why is the date causing a problem?

2) How can I still use column D (or others) as my search criteria and still have all the data in the listbox?

3) How can i restrict what data it shows in the listbox, for example perhaps just columns A, D, F & H?

-----------------

You also mentioned that it would be possible to create on this userform a way to edit the data and have it update what has already been entered.
Would you be able to advise how this can be done?
I weould prefer to use one userform that has the search and editing functions in one rather than two forms or forms with multiple pages if at all possible.

Many Thanks,

To The OP : I've also posted in your thread on VBAExpress : http://vbaexpress.com/forum/showpost.php?p=165273&postcount=10 asking you if you can post of copy of your workbook.
 
Last edited:
Upvote 0
The values in the cells are Excel serial dates. You need to use DateValue(TextBox1.Text) to convert searchTerm from the string in the textbox1 to Excel Serial dates.
 
Upvote 0
The values in the cells are Excel serial dates. You need to use DateValue(TextBox1.Text) to convert searchTerm from the string in the textbox1 to Excel Serial dates.

Thanks for the reply,

I'm really very new at VBA, exactly where in the code would i place DateValue(TextBox1.Text)?

Code:
Function ArrayOfMatchingRows(searchTerm As String) As Variant
    Dim oneCell As Range
    Dim ColumnCount As Long
    Dim DataArray As Variant
    Dim countOfFound As Long, i As Long
 
    ColumnCount = 12
    ReDim DataArray(1 To ColumnCount, 1 To dataRange.Rows.Count)
 
    countOfFound = 0
    For Each oneCell In dataRange().Columns(1).Cells
        If LCase(oneCell.Value) = LCase(searchTerm) Then
            countOfFound = countOfFound + 1
            For i = 1 To ColumnCount
                DataArray(i, countOfFound) = oneCell.Cells(1, i).Value
            Next i
        End If
    Next oneCell
 
    If 0 < countOfFound Then
        ReDim Preserve DataArray(1 To ColumnCount, 1 To countOfFound)
    Else
        ReDim DataArray(0 To 0, 0 To 0)
    End If
 
    ArrayOfMatchingRows = Application.Transpose(DataArray)
End Function

Any suggestions with my other queries?

Thanks,
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,898
Messages
6,127,632
Members
449,391
Latest member
Kersh82

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top