Help clean up my code and answer a couple of questions

O

oblufire

New Member
Joined
Nov 4, 2007
Messages
4
I have gotten help from three sources in putting together this form code.

There is a search function that I got help on but I do not know how to implement. Before I paste the code let me explain what I am doing.

1) form to allow for faster entry of data into a worksheet.
2) search the worksheet and bring up data.
3) if multiple cells have the same data then populate list box.
4) select listbox and paste to worksheet 3 which will auto launch word and mailmerge to make labels.
5) amend data

Problems:
When I amend data from something selected in the list box the active cell does not change so I keep amending the same cell and not the one that I want to amend. I was told to look into row source to help the list box change the active cell but I have yet to figure it out.

Second problem:
I have the search done but it only lets me search for textbox1. I was given a piece of code that would search for any of the text boxes or combo boxes in my form. I do not know how to implement it.


Code: 
'---------------------------------------------------------------------------------------
' Module    : Database Form
' DateTime  : 31/08/2005 10:55
' Author    : Roy Cox
' Purpose   : Data entry form for Excel, with Search facility
' Edited by : Omar Pena
' DateTime  : 25/10/2007  13:36 Tokyo Japan time
'  With help from Paul and Toshiyuki Nemoto
'---------------------------------------------------------------------------------------
Option Explicit
Dim MyArray(20, 19)
Public MyData As Range, c As Range

Private Sub cmbAdd_Click()
'next empty cell in column A
    Set c = Range("a65654", "q65536").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.TextBox5.Value
    c.Offset(0, 5).Value = Me.TextBox6.Value
    c.Offset(0, 6).Value = Me.TextBox7.Value
    c.Offset(0, 7).Value = Me.ComboBox1.Value
    c.Offset(0, 8).Value = Me.TextBox10.Value
    c.Offset(0, 9).Value = Me.ComboBox2.Value
    c.Offset(0, 10).Value = Me.TextBox8.Value
    c.Offset(0, 11).Value = Me.ComboBox5.Value
    c.Offset(0, 12).Value = Me.TextBox9.Value
    c.Offset(0, 13).Value = Me.ComboBox3.Value
    c.Offset(0, 14).Value = Me.ComboBox4.Value
    c.Offset(0, 15).Value = Me.TextBox11.Value
    c.Offset(0, 16).Value = Me.TextBox12.Value
    'clear the form
    With Me
        .TextBox1.Value = vbNullString
        .TextBox2.Value = vbNullString
        .TextBox3.Value = vbNullString
        .TextBox4.Value = vbNullString
        .TextBox5.Value = vbNullString
        .TextBox6.Value = vbNullString
        .TextBox7.Value = vbNullString
        .ComboBox1.Value = vbNullString
        .TextBox10.Value = vbNullString
        .ComboBox2.Value = vbNullString
        .TextBox8.Value = vbNullString
        .ComboBox5.Value = vbNullString
        .TextBox9.Value = vbNullString
        .ComboBox3.Value = vbNullString
        .ComboBox4.Value = vbNullString
        .TextBox11.Value = vbNullString
        .TextBox12.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
            .TextBox5.Value = vbNullString
            .TextBox6.Value = vbNullString
            .TextBox7.Value = vbNullString
            .ComboBox1.Value = vbNullString
            .TextBox10.Value = vbNullString
            .ComboBox2.Value = vbNullString
            .TextBox8.Value = vbNullString
            .ComboBox5.Value = vbNullString
            .TextBox9.Value = vbNullString
            .ComboBox3.Value = vbNullString
            .ComboBox4.Value = vbNullString
            .TextBox11.Value = vbNullString
            .TextBox12.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
    Dim RecCnt As Integer
    Dim i As Integer
    
   
' I did not know how to implement this code.


'hdr_Row = 6
 'RecCnt = application.worksheetfunction.counta(range(cells(hdr_Row +1,1),cells(65000,1)
' or whatever the range is for I = 1 to RecCnt  '(keep in mind that this is a count of records, not rows!
 '  selectflag = False
  ' If (txtbox1.Value = "") Or (InStr(1, Cells(i, 1), TextBox1.Value) > 0) Then
   '   If (txtbox2.Value = "") Or (InStr(1, Cells(i, 2), TextBox2.Value) > 0) Then
    '  selectflag = True
    'End If
   'End If
  'If selectflag Then
      'Add line to ListBox
  'End If
'Next i
    
    
    Set rSearch = Sheet1.Range("a6", Range("a65536").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
                .TextBox1.Value = c.Offset(0, 0).Value
                .TextBox2.Value = c.Offset(0, 1).Value
                .TextBox3.Value = c.Offset(0, 2).Value
                .TextBox4.Value = c.Offset(0, 3).Value
                .TextBox5.Value = c.Offset(0, 4).Value
                .TextBox6.Value = c.Offset(0, 5).Value
                .TextBox7.Value = c.Offset(0, 6).Value
                .ComboBox1.Value = c.Offset(0, 7).Value
                .TextBox10.Value = c.Offset(0, 8).Value
                .ComboBox2.Value = c.Offset(0, 9).Value
                .TextBox8.Value = c.Offset(0, 10).Value
                .ComboBox5.Value = c.Offset(0, 11).Value
                .TextBox9.Value = c.Offset(0, 12).Value
                .ComboBox3.Value = c.Offset(0, 13).Value
                .ComboBox4.Value = c.Offset(0, 14).Value
                .TextBox11.Value = c.Offset(0, 15).Value
                .TextBox12.Value = c.Offset(0, 16).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 = 456
            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.TextBox5.Value
    c.Offset(0, 5).Value = Me.TextBox6.Value
    c.Offset(0, 6).Value = Me.TextBox7.Value
    c.Offset(0, 7).Value = Me.ComboBox1.Value
    c.Offset(0, 8).Value = Me.TextBox10.Value
    c.Offset(0, 9).Value = Me.ComboBox2.Value
    c.Offset(0, 10).Value = Me.TextBox8.Value
    c.Offset(0, 11).Value = Me.ComboBox5.Value
    c.Offset(0, 12).Value = Me.TextBox9.Value
    c.Offset(0, 13).Value = Me.ComboBox3.Value
    c.Offset(0, 14).Value = Me.ComboBox4.Value
    c.Offset(0, 15).Value = Me.TextBox11.Value
    c.Offset(0, 16).Value = Me.TextBox12.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
            .TextBox5.Value = vbNullString
            .TextBox6.Value = vbNullString
            .TextBox7.Value = vbNullString
            .ComboBox1.Value = vbNullString
            .TextBox10.Value = vbNullString
            .ComboBox2.Value = vbNullString
            .TextBox8.Value = vbNullString
            .ComboBox5.Value = vbNullString
            .TextBox9.Value = vbNullString
            .ComboBox3.Value = vbNullString
            .ComboBox4.Value = vbNullString
            .TextBox11.Value = vbNullString
            .TextBox12.Value = vbNullString
    End With
    Application.ScreenUpdating = True
End Sub
Private Sub cmbFindAll_Click()
    Dim x, y
     For x = 0 To 19
     For y = 0 To 18
        MyArray(x, y) = ""
       Next y
     Next x
      
    Dim FirstAddress As String
    Dim strFind As String    'what to find
    Dim rSearch As Range     'range to search
    Dim fndA, fndB, fndC, fndD, fndE, fndF, fndG, fndH, fndI, fndJ, fndK, fndL, fndM, fndN, fndO, fndP, fndQ   As String
    Dim head1, head2, head3, head4, head5, head6, head7, head8, head9, head10, head11, head12, head13, head14, head15, head16, head17 As String    'heading s for list
    Dim i As Integer
    i = 1
    Set rSearch = Sheet1.Range("a6", Range("a65536").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("a7").Value
            head2 = Range("b7").Value
            head3 = Range("c7").Value
            head4 = Range("d7").Value
            head5 = Range("e7").Value
            head6 = Range("f7").Value
            head7 = Range("g7").Value
            head8 = Range("h7").Value
            head9 = Range("i7").Value
            head10 = Range("j7").Value
            head11 = Range("k7").Value
            head12 = Range("l7").Value
            head13 = Range("m7").Value
            head14 = Range("n7").Value
            head15 = Range("o7").Value
            head16 = Range("p7").Value
            head17 = Range("q7").Value
            With Me.ListBox1
                MyArray(0, 0) = head1
                MyArray(0, 1) = head2
                MyArray(0, 2) = head3
                MyArray(0, 3) = head4
                MyArray(0, 4) = head5
                MyArray(0, 5) = head6
                MyArray(0, 6) = head7
                MyArray(0, 7) = head8
                MyArray(0, 8) = head9
                MyArray(0, 9) = head10
                MyArray(0, 10) = head11
                MyArray(0, 11) = head12
                MyArray(0, 12) = head13
                MyArray(0, 13) = head14
                MyArray(0, 14) = head15
                MyArray(0, 15) = head16
                MyArray(0, 16) = head17
                
            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
                fndE = c.Offset(0, 4).Value
                fndF = c.Offset(0, 5).Value
                fndG = c.Offset(0, 6).Value
                fndH = c.Offset(0, 7).Value
                fndI = c.Offset(0, 8).Value
                fndJ = c.Offset(0, 9).Value
                fndK = c.Offset(0, 10).Value
                fndL = c.Offset(0, 11).Value
                fndM = c.Offset(0, 12).Value
                fndN = c.Offset(0, 13).Value
                fndO = c.Offset(0, 14).Value
                fndP = c.Offset(0, 15).Value
                fndQ = c.Offset(0, 16).Value
                
                
                MyArray(i, 0) = fndA
                MyArray(i, 1) = fndB
                MyArray(i, 2) = fndC
                MyArray(i, 3) = fndD
                MyArray(i, 4) = fndE
                MyArray(i, 5) = fndF
                MyArray(i, 6) = fndG
                MyArray(i, 7) = fndH
                MyArray(i, 8) = fndI
                MyArray(i, 9) = fndJ
                MyArray(i, 10) = fndK
                MyArray(i, 11) = fndL
                MyArray(i, 12) = fndM
                MyArray(i, 13) = fndN
                MyArray(i, 14) = fndO
                MyArray(i, 15) = fndP
                MyArray(i, 16) = fndQ
                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("a65536").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
        .TextBox5.Value = LastCl.Offset(0, 4).Value
        .TextBox6.Value = LastCl.Offset(0, 5).Value
        .TextBox7.Value = LastCl.Offset(0, 6).Value
        .ComboBox1.Value = LastCl.Offset(0, 7).Value
        .TextBox10.Value = LastCl.Offset(0, 8).Value
        .ComboBox2.Value = LastCl.Offset(0, 9).Value
        .TextBox8.Value = LastCl.Offset(0, 10).Value
        .ComboBox5.Value = LastCl.Offset(0, 11).Value
        .TextBox9.Value = LastCl.Offset(0, 12).Value
        .ComboBox3.Value = LastCl.Offset(0, 13).Value
        .ComboBox4.Value = LastCl.Offset(0, 14).Value
        .TextBox11.Value = LastCl.Offset(0, 15).Value
        .TextBox12.Value = LastCl.Offset(0, 16).Value
    End With
End Sub

Private Sub cmdLabel_Click()
Dim iListCount As Integer, iColCount As Integer
Dim iRow As Integer
Dim rStartCell As Range
Dim i, Msg
Dim stat As Integer

Sheets("Address").Range("a2:q65356").Delete xlShiftUp

Set rStartCell = Sheets("Address").Range("A65536").End(xlUp).Offset(1, 0)
    For iListCount = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(iListCount) = True Then  'User has selected
      ListBox1.Selected(iListCount) = False
      iRow = iRow + 1
        For iColCount = 0 To Range("a1:q1").Columns.Count - 1
       rStartCell.Cells(iRow, iColCount + 1).Value = _
       ListBox1.List(iListCount, iColCount)
      Next iColCount
   End If
Next iListCount

Set rStartCell = Nothing

Msg = ""
  'Erase contents of Address list
  
  For i = 1 To ListBox1.ListCount - 1
        If (ListBox1.List(i, 0) <> "") Then
            Msg = Msg & Chr(13) & ListBox1.List(i, 0)
        End If
    Next i
 MsgBox Msg
stat = Shell("WinWord.exe C:\FreedomStudents\Labels.doc")
End Sub

Private Sub cmnbFirst_Click()
    Dim FirstCl As Range

    'first data Entry
    Set FirstCl = Range("a1").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
        .TextBox5.Value = FirstCl.Offset(0, 4).Value
        .TextBox6.Value = FirstCl.Offset(0, 5).Value
        .TextBox7.Value = FirstCl.Offset(0, 6).Value
        .ComboBox1.Value = FirstCl.Offset(0, 7).Value
        .TextBox10.Value = FirstCl.Offset(0, 8).Value
        .ComboBox2.Value = FirstCl.Offset(0, 9).Value
        .TextBox8.Value = FirstCl.Offset(0, 10).Value
        .ComboBox5.Value = FirstCl.Offset(0, 11).Value
        .TextBox9.Value = FirstCl.Offset(0, 12).Value
        .ComboBox3.Value = FirstCl.Offset(0, 13).Value
        .ComboBox4.Value = FirstCl.Offset(0, 14).Value
        .TextBox11.Value = FirstCl.Offset(0, 15).Value
        .TextBox12.Value = FirstCl.Offset(0, 16).Value
    End With
End Sub
Private Sub ListBox1_Click()
    Dim r As Integer
   Dim strRowSource As String
   
    Debug.Print Me.ListBox1.ListCount
    If Me.ListBox1.ListIndex > 0 Then    'not selected
        r = Me.ListBox1.ListIndex
        If (Me.ListBox1.List(r, 0) <> "") Then
            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)
                .TextBox5.Value = ListBox1.List(r, 4)
                .TextBox6.Value = ListBox1.List(r, 5)
                .TextBox7.Value = ListBox1.List(r, 6)
                .ComboBox1.Value = ListBox1.List(r, 7)
                .TextBox10.Value = ListBox1.List(r, 8)
                .ComboBox2.Value = ListBox1.List(r, 9)
                .TextBox8.Value = ListBox1.List(r, 10)
                .ComboBox5.Value = ListBox1.List(r, 11)
                .TextBox9.Value = ListBox1.List(r, 12)
                .ComboBox3.Value = ListBox1.List(r, 13)
                .ComboBox4.Value = ListBox1.List(r, 14)
                .TextBox11.Value = ListBox1.List(r, 15)
                .TextBox12.Value = ListBox1.List(r, 16)
                .cmbAmend.Enabled = True      'allow amendment or
                .cmbDelete.Enabled = True     'allow record deletion
                .cmbAdd.Enabled = False       'don't want duplicate
            End With
            
               
    With ListBox1
        strRowSource = .RowSource
        .RowSource = vbNullString
         'Set back so it updates, use a new  RowSource
        .RowSource = strRowSource
    End With
            End If
    End If
   
End Sub

Private Sub UserForm_Initialize()
    Set MyData = Sheet1.Range("a5").CurrentRegion   'database
    
    With Me
        .Caption = "Students Data"    'userform caption
    End With
    
    
    With ComboBox1
        .AddItem "Adult"
        .AddItem "Child"
        
    End With
    With ComboBox2
        .AddItem "Ken"
        .AddItem "Chris"
        .AddItem "Omar"
        .AddItem "Alan"
    End With
     With ComboBox3
        .AddItem "Naka"
        .AddItem "Hitachinaka"
        
    End With
     With ComboBox4
        .AddItem "Flyer"
        .AddItem "Internet"
        .AddItem "Student"
        .AddItem "Walk-in"
        .AddItem "Other"
    End With
      With ComboBox5
        .AddItem "First Time"
        .AddItem "Beginner"
        .AddItem "Intermediate"
        .AddItem "High"
    End With
    

End Sub
[/code]
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Code: 
        .TextBox1.Value = vbNullString 
        .TextBox2.Value = vbNullString 
        .TextBox3.Value = vbNullString 
        .TextBox4.Value = vbNullString 
        .TextBox5.Value = vbNullString 
        .TextBox6.Value = vbNullString 
        .TextBox7.Value = vbNullString 
        .ComboBox1.Value = vbNullString 
        .TextBox10.Value = vbNullString 
        .ComboBox2.Value = vbNullString 
        .TextBox8.Value = vbNullString 
        .ComboBox5.Value = vbNullString 
        .TextBox9.Value = vbNullString 
        .ComboBox3.Value = vbNullString 
        .ComboBox4.Value = vbNullString 
        .TextBox11.Value = vbNullString 
        .TextBox12.Value = vbNullString
Are these all the controls on the userform?
Are there any other controls, apart from ListBox1 ?
 
Upvote 0
Half part...
Code: 
Option Explicit
Public MyData As Range, c As Range

Private Sub cmbAdd_Click()
Dim ctrl As Control
'next empty cell in column A
    Set c = Range("a65654", "q65536").End(xlUp).Offset(1, 0)
    Application.ScreenUpdating = False    'speed up, hide task
    'write userform entries to database
    With Me
        c.Resize(17).Value = Array(.TextBox1.Value,.TextBox2.Value, _
                    .TextBox3.Value, .TextBox4.Value,.TextBox5.Value, _
                    .TextBox6.Value,.TextBox7.Value,.ComboBox1.Value, _
                    .TextBox10.Value,.ComboBox2.Value,.TextBox8.Value, _
                    .ComboBox5.Value,.TextBox9.Value,.ComboBox3.Value, _
                    .ComboBox4.Value,.TextBox11.Value,.TextBox12.Value)
        For Each ctrl In .Controls
            Select Case TypeName(ctrl)
                Case "TextBox", "ComboBox" : ctrl.Value = vbNullString
            End Select
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub cmbDelete_Click()
    Dim msgResponse As String, ctrl As Control    'confirm delete
    Application.ScreenUpdating = False
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
                         vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse    'action dependent on response
    Case vbYes
        Set c = ActiveCell
        c.EntireRow.Delete 
        With Me
            .cmbAmend.Enabled = False     
            .cmbDelete.Enabled = False   
            .cmbAdd.Enabled = True       

            For Each ctrl In .Controls
                Select Case TypeName(ctrl)
                    Case "TextBox", "ComboBox" : ctrl.Value = vbNullString
                End Select
            Next
        End With
    Case vbNo
        Exit Sub 
    End Select
    Application.ScreenUpdating = True
End Sub

Private Sub cmbFind_Click()
Dim strFind, FirstAddress As String   'what to find
    Dim rSearch As Range  
    Dim RecCnt As Integer
    Dim i As Integer, n As Integer
    
   
' I did not know how to implement this code.

 Set rSearch = Sheet1.Range("a6", Range("a65536").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    
            c.Select
            With Me    'load entry to form
                .ComboBox1.Value = c.Offset(, 7).Value
                .ComboBox2.Value = c.Offset(, 9).Value
                .ComboBox3.Value = c.Offset(, 13).Value
                .ComboBox4.Value = c.Offset(0, 14).Value
                .ComboBox5.Value = c.Offset(, 11).Value
                For n = 1 To 12
                    Select Case n
                        Case 1 To 7
                            .Controls("TextBox" & n).Value = c.Offset(, n-1).Value
                        Case 8
                           .Controls("TextBox" & n).Value = c.Offset(10).Value
                        Case 9
                           .Controls("TextBox" & n).Value = c.Offset(, 12).Value
                        Case 10
                           .Controls("TextBox" & n).Value = c.Offset(, 8).Value
                        Case 11 To 12
                           .Controls("TextBox" & n).Value = c.Offset(, n + 4).Value 
                    End Select
                Next
                .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 = 456
            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
    With Me
    With Me
        c.Resize(17).Value = Array(.TextBox1.Value,.TextBox2.Value, _
                    .TextBox3.Value, .TextBox4.Value,.TextBox5.Value, _
                    .TextBox6.Value,.TextBox7.Value,.ComboBox1.Value, _
                    .TextBox10.Value,.ComboBox2.Value,.TextBox8.Value, _
                    .ComboBox5.Value,.TextBox9.Value,.ComboBox3.Value, _
                    .ComboBox4.Value,.TextBox11.Value,.TextBox12.Value)

    'clear the form
        For Each ctrl In .Controls
            Select Case TypeName(ctrl)
                Case "TextBox", "ComboBox" : .Value = vbNullString
            End Select
        Next
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
    End With
    Application.ScreenUpdating = True
End Sub
Private Sub cmbFindAll_Click()
    Dim x, y
     ReDim myArray
      
    Dim FirstAddress As String
    Dim strFind As String    'what to find
    Dim rSearch As Range     'range to search
    Dim MyArray(), n As Long, t As Long
    Dim i As Integer
    i = 1
    Set rSearch = Sheet1.Range("a6", Range("a65536").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
            ReDim MyArray(1 To 17, 1 To 1)
            For t = 1 To 17 : MyArray(t,1) = Cells(7,t).Value : Next
            n = 1
            FirstAddress = c.Address
            Do
                n = n + 1 : ReDim Preserve MyArray(1 To 17, 1 To n)
                For t = 1 To 17 : MyArray(t,n)=c.Offset(,t-1).Value : Next
                Set c = .FindNext(c)
            Loop While c.Address <> FirstAddress

        End If
    End With
    'Load data into LISTBOX
    
    Me.ListBox1.Column = MyArray
End Sub
 
Upvote 0
I copied and pasted that code and there seems to be a problem in the add part of the code.

Code: 
Set c = Range("a65654", "q65536").End(xlUp).Offset(1, 0)

turns yellow

and in the find all function
Code: 
ReDim MyArray

turns red
 
Upvote 0
I copied and pasted that code and there seems to be a problem in the add part of the code.

Code: 
Set c = Range("a65654", "q65536").End(xlUp).Offset(1, 0)
turns yellow
Click to expand...
No idea, that line was from your original code.
and in the find all function
Code: 
ReDim MyArray

turns red
Click to expand...
Just delete that line.
 
Upvote 0
This was a simple mistake on my side i went over the max number in the range.

Code: 
Set c = Range("a65654", "q65536").End(xlUp).Offset(1, 0)


I do keep getting an error on the case section in the find portion. Can you explain to me how the case part works?
 
Upvote 0
Ahhh, I forgot yo delete the line of

"If n = 1 Then"

In the Select Case statement. (Fixed)

Can you copy the code again?
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Search all working documents
Replies
1
Views
357
mody300
M
J
  • Question Question
User form successfully ran but no results are showing
Replies
1
Views
294
rlv01
R
I
  • Question Question
Have the code select the cell that relates to what was searched for
Replies
0
Views
209
ipbr21054
I
I
  • Question Question
Userform does not show leading 0 for telephone number
Replies
1
Views
258
ipbr21054
I
E
  • Question Question
VBA code clean up
Replies
9
Views
482
mumps
mumps

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

Share this page

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