Search code help

[Juan V Gomez]

I am frustrated and out of ideas (and a little sick, which isn't helping my mood today). Attached is the code for a customer tracking spreadsheet that I've developed for the company I work for (for some reason I can't post attachemnts, or else I'd post the excel file). Things were working fine, and then the search function starting crashing on me (and the receptionist which uses the file). How it is suppose to work, is the user can search by either Customer Name, Company Name or Job Number. It should auto fill all the fields if there is only one result, and return a list to the listbox if there is multiple results. At that point the user can click on the results in the listbox, which populates the rest of the fields. The user then should be able to amend the record and the changes they made should write over the existing row of data.

What it is doing is a whole mess of wacky things. Some amendments write to the first row, some don't amend at all. If you search by Job Number it just crashes. I'm not an VBA expert and have largely been thrown to the fire by my boss on this project. So any help on what's wrong with the code or suggestions on how to make things work better are appreciated. Quick replies get a gold star from me, as I suppose to give an update to all our Territory Managers tomorrow. I wasn't concerned about this deadline when things seemed to work fine on Friday, and now today, error, error, error....

Thanks for any help in advance.

Dim MyData     As Range
Dim c          As Range
Dim rFound     As Range
Dim r          As Long
Dim rng        As Range
Const frmMax   As Long = 400
Const frmHt    As Long = 450
Const frmWidth As Long = 650
Dim sFileName  As String        'image name
Dim oCtrl      As MSForms.Control


Private Sub cmbAdd_Click()
    'next empty cell in column A
    Set c = Range("a65536").End(xlUp).Offset(1, 0)
    Application.ScreenUpdating = False    'speed up, hide task
    'write userform entries to database
    With Me
        c.Value = .CustName.Value
        c.Offset(0, 1).Value = .TerMgr.Value
        c.Offset(0, 2).Value = .CompName.Value
        c.Offset(0, 3).Value = .JobTitle.Value
        c.Offset(0, 4).Value = .MailAdd2.Value
        c.Offset(0, 5).Value = .EstCost.Value
        c.Offset(0, 6).Value = .SoldDate.Value
        c.Offset(0, 7).Value = .MailAdd1.Value
        c.Offset(0, 8).Value = .SiteAdd1.Value
        c.Offset(0, 9).Value = .SiteAdd2.Value
        c.Offset(0, 10).Value = .HomePh.Value
        c.Offset(0, 11).Value = .WorkPh.Value
        c.Offset(0, 12).Value = .MobilePh.Value
        c.Offset(0, 13).Value = .FaxNum.Value
        c.Offset(0, 14).Value = .EmailAdd.Value
        c.Offset(0, 15).Value = .BldgType.Value
        c.Offset(0, 16).Value = .JobDisc.Value
        c.Offset(0, 17).Value = .Notes.Value
        c.Offset(0, 18).Value = .WallColor.Value
        c.Offset(0, 19).Value = .RoofColor.Value
        c.Offset(0, 20).Value = .Stage.Value
        c.Offset(0, 21).Value = .Completed.Value
        c.Offset(0, 22).Value = .ProsNum.Value
        c.Offset(0, 31).Value = .Canceled.Value
        c.Offset(0, 24).Value = .ThankYouSent.Value
        c.Offset(0, 25).Value = .ThankYouDate.Value
        c.Offset(0, 26).Value = .SurveySent.Value
        c.Offset(0, 27).Value = .SurveyDate.Value
        c.Offset(0, 28).Value = .ReferralSent.Value
        c.Offset(0, 31).Value = .Canceled.Value
        'clear the form
        ClearControls
    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
                ClearControls
            End With

        Case vbNo
            Exit Sub    'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub

Private Sub cmbFindName_Click()
    Dim strFind As String    'what to find
    Dim FirstAddress As String
    Dim rSearch As Range  'range to search
    Dim c As Range, a() As String, n As Long, I As Long
    Set rSearch = Sheet1.Range("a1", Range("a65536").End(xlUp))
    Set rng = Sheet1.Range("a1", Range("a65536").End(xlUp))
    Dim f As Integer

    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Me.CustName.Value    'what to look for

    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            With Me    'load entry to form
                .CustName.Value = c.Value
                .TerMgr.Value = c.Offset(0, 1).Value
                .CompName.Value = c.Offset(0, 2).Value
                .JobTitle.Value = c.Offset(0, 3).Value
                .MailAdd2.Value = c.Offset(0, 4).Value
                .EstCost.Value = c.Offset(0, 5).Value
                .SoldDate.Value = c.Offset(0, 6).Value
                .MailAdd1.Value = c.Offset(0, 7).Value
                .SiteAdd1.Value = c.Offset(0, 8).Value
                .SiteAdd2.Value = c.Offset(0, 9).Value
                .HomePh.Value = c.Offset(0, 10).Value
                .WorkPh.Value = c.Offset(0, 11).Value
                .MobilePh.Value = c.Offset(0, 12).Value
                .FaxNum.Value = c.Offset(0, 13).Value
                .EmailAdd.Value = c.Offset(0, 14).Value
                .BldgType.Value = c.Offset(0, 15).Value
                .JobDisc.Value = c.Offset(0, 16).Value
                .Notes.Value = c.Offset(0, 17).Value
                .WallColor.Value = c.Offset(0, 18).Value
                .RoofColor.Value = c.Offset(0, 19).Value
                .Stage.Value = c.Offset(0, 20).Value
                .Completed.Value = c.Offset(0, 21).Value
                .ProsNum.Value = c.Offset(0, 22).Value
                .JobNum.Value = c.Offset(0, 23).Value
                .ThankYouSent.Value = c.Offset(0, 24).Value
                .ThankYouDate.Value = c.Offset(0, 25).Value
                .SurveySent.Value = c.Offset(0, 26).Value
                .SurveyDate.Value = c.Offset(0, 27).Value
                .ReferralSent.Value = c.Offset(0, 28).Value
                .Canceled.Value = c.Offset(0, 31).Value
                .cmbAmend.Enabled = True     'allow amendment or
                .cmbDelete.Enabled = True    'allow record deletion
                .cmbAdd.Enabled = True      '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
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")

                    Case vbOK
                        'FindAll
                        With Sheet9  'Keep as Sheet9  Whole list box craps out otherwise
                            If Not .AutoFilterMode Then .Range("A1").AutoFilter
                            rSearch.AutoFilter Field:=1, Criteria1:=strFind & "*"
                            Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
                            Me.ListBox1.Clear
                            For Each c In rng
                                n = n + 1: ReDim Preserve a(0 To 31, 0 To n)
                                For I = 0 To 31
                                    a(I, n) = c.Offset(, I).Value
                                Next
                            Next
                        End With
                    If n > 0 Then Me.ListBox1.Column = a
                    Case vbCancel
                        'do nothing
                End Select
                Me.Height = frmMax

            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("A1").AutoFilter

End Sub


Private Sub cmbFindComp_Click()
    Dim strFind As String    'what to find
    Dim FirstAddress As String
    Dim rSearch As Range  'range to search
    Dim c As Range, a() As String, n As Long, I As Long
    Set rSearch = Sheet1.Range("c1", Range("c65536").End(xlUp))
    Set rng = Sheet1.Range("c1", Range("c65536").End(xlUp))
    Dim f As Integer

    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Me.CompName.Value    'what to look for

    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            With Me    'load entry to form
                .CustName.Value = c.Offset(0, -2).Value
                .TerMgr.Value = c.Offset(0, -1).Value
                .CompName.Value = c.Value
                .JobTitle.Value = c.Offset(0, 1).Value
                .MailAdd2.Value = c.Offset(0, 2).Value
                .EstCost.Value = c.Offset(0, 3).Value
                .SoldDate.Value = c.Offset(0, 4).Value
                .MailAdd1.Value = c.Offset(0, 5).Value
                .SiteAdd1.Value = c.Offset(0, 6).Value
                .SiteAdd2.Value = c.Offset(0, 7).Value
                .HomePh.Value = c.Offset(0, 8).Value
                .WorkPh.Value = c.Offset(0, 9).Value
                .MobilePh.Value = c.Offset(0, 10).Value
                .FaxNum.Value = c.Offset(0, 11).Value
                .EmailAdd.Value = c.Offset(0, 12).Value
                .BldgType.Value = c.Offset(0, 13).Value
                .JobDisc.Value = c.Offset(0, 14).Value
                .Notes.Value = c.Offset(0, 15).Value
                .WallColor.Value = c.Offset(0, 16).Value
                .RoofColor.Value = c.Offset(0, 17).Value
                .Stage.Value = c.Offset(0, 18).Value
                .Completed.Value = c.Offset(0, 19).Value
                .ProsNum.Value = c.Offset(0, 20).Value
                .JobNum.Value = c.Offset(0, 21).Value
                .ThankYouSent.Value = c.Offset(0, 22).Value
                .ThankYouDate.Value = c.Offset(0, 23).Value
                .SurveySent.Value = c.Offset(0, 24).Value
                .SurveyDate.Value = c.Offset(0, 25).Value
                .ReferralSent.Value = c.Offset(0, 26).Value
                .Canceled.Value = c.Offset(0, 29).Value
                .cmbAmend.Enabled = True     'allow amendment or
                .cmbDelete.Enabled = True    'allow record deletion
                .cmbAdd.Enabled = True      '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
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")

                    Case vbOK
                        'FindAll
                        With Sheet9  'Keep as Sheet9  Whole list box craps out otherwise
                            If Not .AutoFilterMode Then .Range("A1").AutoFilter
                            rSearch.AutoFilter Field:=1, Criteria1:=strFind & "*"
                            Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
                            Me.ListBox1.Clear
                            For Each c In rng
                                n = n + 1: ReDim Preserve a(-2 To 29, 0 To n)
                                For I = -2 To 29
                                    a(I, n) = c.Offset(, I).Value
                                Next
                            Next
                        End With
                    If n > 0 Then Me.ListBox1.Column = a
                    Case vbCancel
                        'do nothing
                End Select
                Me.Height = frmMax

            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("C1").AutoFilter

End Sub


Private Sub cmbFindNum_Click()
    Dim strFind As String    'what to find
    Dim FirstAddress As String
    Dim rSearch As Range  'range to search
    Dim c As Range, a() As String, n As Long, I As Long
    Set rSearch = Sheet1.Range("x1", Range("x65536").End(xlUp))
    Set rng = Sheet1.Range("x1", Range("x65536").End(xlUp))
    Dim f As Integer

    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Me.JobNum.Value    'what to look for

    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            With Me    'load entry to form
                .CustName.Value = c.Offset(0, -23).Value
                .TerMgr.Value = c.Offset(0, -22).Value
                .CompName.Value = c.Offset(0, -21).Value
                .JobTitle.Value = c.Offset(0, -20).Value
                .MailAdd2.Value = c.Offset(0, -19).Value
                .EstCost.Value = c.Offset(0, -18).Value
                .SoldDate.Value = c.Offset(0, -17).Value
                .MailAdd1.Value = c.Offset(0, -16).Value
                .SiteAdd1.Value = c.Offset(0, -15).Value
                .SiteAdd2.Value = c.Offset(0, -14).Value
                .HomePh.Value = c.Offset(0, -13).Value
                .WorkPh.Value = c.Offset(0, -12).Value
                .MobilePh.Value = c.Offset(0, -11).Value
                .FaxNum.Value = c.Offset(0, -10).Value
                .EmailAdd.Value = c.Offset(0, -9).Value
                .BldgType.Value = c.Offset(0, -8).Value
                .JobDisc.Value = c.Offset(0, -7).Value
                .Notes.Value = c.Offset(0, -6).Value
                .WallColor.Value = c.Offset(0, -5).Value
                .RoofColor.Value = c.Offset(0, -4).Value
                .Stage.Value = c.Offset(0, -3).Value
                .Completed.Value = c.Offset(0, -2).Value
                .ProsNum.Value = c.Offset(0, -1).Value
                .JobNum.Value = c.Value
                .ThankYouSent.Value = c.Offset(0, 1).Value
                .ThankYouDate.Value = c.Offset(0, 2).Value
                .SurveySent.Value = c.Offset(0, 3).Value
                .SurveyDate.Value = c.Offset(0, 4).Value
                .ReferralSent.Value = c.Offset(0, 5).Value
                .Canceled.Value = c.Offset(0, 6).Value
                .cmbAmend.Enabled = True     'allow amendment or
                .cmbDelete.Enabled = True    'allow record deletion
                .cmbAdd.Enabled = True      '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
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")

                    Case vbOK
                        'FindAll
                        With Sheet9
                            If Not .AutoFilterMode Then .Range("J1").AutoFilter
                            rSearch.AutoFilter Field:=1, Criteria1:=strFind & "*"
                            Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
                            Me.ListBox1.Clear
                            For Each c In rng
                                n = n + 1: ReDim Preserve a(-23 To 6, 0 To n)
                                For I = -23 To 6
                                    a(I, n) = c.Offset(, I).Value
                                Next
                            Next
                        End With
                    If n > 0 Then Me.ListBox1.Column = a
                    Case vbCancel
                        'do nothing
                End Select
                Me.Height = frmMax

            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("X1").AutoFilter

End Sub

Private Sub cmbAmend_Click()
    Application.ScreenUpdating = False
    If rng Is Nothing Then GoTo skip
    For Each c In rng
        If r = 0 Then c.Select
        r = r - 1
    Next c
skip:
    
    Set c = ActiveCell
    
    If c = CustName Then
    c.Value = Me.CustName.Value          ' write amendments to database
    c.Offset(0, 1).Value = Me.TerMgr.Value
    c.Offset(0, 2).Value = Me.CompName.Value
    c.Offset(0, 3).Value = Me.JobTitle.Value
    c.Offset(0, 4).Value = Me.MailAdd2.Value
    c.Offset(0, 5).Value = Me.EstCost.Value
    c.Offset(0, 6).Value = Me.SoldDate.Value
    c.Offset(0, 7).Value = Me.MailAdd1.Value
    c.Offset(0, 8).Value = Me.SiteAdd1.Value
    c.Offset(0, 9).Value = Me.SiteAdd2.Value
    c.Offset(0, 10).Value = Me.HomePh.Value
    c.Offset(0, 11).Value = Me.WorkPh.Value
    c.Offset(0, 12).Value = Me.MobilePh.Value
    c.Offset(0, 13).Value = Me.FaxNum.Value
    c.Offset(0, 14).Value = Me.EmailAdd.Value
    c.Offset(0, 15).Value = Me.BldgType.Value
    c.Offset(0, 16).Value = Me.JobDisc.Value
    c.Offset(0, 17).Value = Me.Notes.Value
    c.Offset(0, 18).Value = Me.WallColor.Value
    c.Offset(0, 19).Value = Me.RoofColor.Value
    c.Offset(0, 20).Value = Me.Stage.Value
    c.Offset(0, 21).Value = Me.Completed.Value
    c.Offset(0, 22).Value = Me.ProsNum.Value
    c.Offset(0, 23).Value = Me.JobNum.Value
    c.Offset(0, 24).Value = Me.ThankYouSent.Value
    c.Offset(0, 25).Value = Me.ThankYouDate.Value
    c.Offset(0, 26).Value = Me.SurveySent.Value
    c.Offset(0, 27).Value = Me.SurveyDate.Value
    c.Offset(0, 28).Value = Me.ReferralSent.Value
    c.Offset(0, 31).Value = Me.Canceled.Value
 
    
    ElseIf c = CompName Then
    c.Offset(0, -2).Value = Me.CustName.Value          ' write amendments to database
    c.Offset(0, -1).Value = Me.TerMgr.Value
    c.Value = Me.CompName.Value
    c.Offset(0, 1).Value = Me.JobTitle.Value
    c.Offset(0, 2).Value = Me.MailAdd2.Value
    c.Offset(0, 3).Value = Me.EstCost.Value
    c.Offset(0, 4).Value = Me.SoldDate.Value
    c.Offset(0, 5).Value = Me.MailAdd1.Value
    c.Offset(0, 6).Value = Me.SiteAdd1.Value
    c.Offset(0, 7).Value = Me.SiteAdd2.Value
    c.Offset(0, 8).Value = Me.HomePh.Value
    c.Offset(0, 9).Value = Me.WorkPh.Value
    c.Offset(0, 10).Value = Me.MobilePh.Value
    c.Offset(0, 11).Value = Me.FaxNum.Value
    c.Offset(0, 12).Value = Me.EmailAdd.Value
    c.Offset(0, 13).Value = Me.BldgType.Value
    c.Offset(0, 14).Value = Me.JobDisc.Value
    c.Offset(0, 15).Value = Me.Notes.Value
    c.Offset(0, 16).Value = Me.WallColor.Value
    c.Offset(0, 17).Value = Me.RoofColor.Value
    c.Offset(0, 18).Value = Me.Stage.Value
    c.Offset(0, 19).Value = Me.Completed.Value
    c.Offset(0, 20).Value = Me.ProsNum.Value
    c.Offset(0, 21).Value = Me.JobNum.Value
    c.Offset(0, 22).Value = Me.ThankYouSent.Value
    c.Offset(0, 23).Value = Me.ThankYouDate.Value
    c.Offset(0, 24).Value = Me.SurveySent.Value
    c.Offset(0, 25).Value = Me.SurveyDate.Value
    c.Offset(0, 26).Value = Me.ReferralSent.Value
    c.Offset(0, 29).Value = Me.Canceled.Value
    
    Else: c = JobNum
    c.Offset(0, -23).Value = Me.CustName.Value          ' write amendments to database
    c.Offset(0, -22).Value = Me.TerMgr.Value
    c.Offset(0, -21).Value = Me.CompName.Value
    c.Offset(0, -20).Value = Me.JobTitle.Value
    c.Offset(0, -19).Value = Me.MailAdd2.Value
    c.Offset(0, -18).Value = Me.EstCost.Value
    c.Offset(0, -17).Value = Me.SoldDate.Value
    c.Offset(0, -16).Value = Me.MailAdd1.Value
    c.Offset(0, -15).Value = Me.SiteAdd1.Value
    c.Offset(0, -14).Value = Me.SiteAdd2.Value
    c.Offset(0, -13).Value = Me.HomePh.Value
    c.Offset(0, -12).Value = Me.WorkPh.Value
    c.Offset(0, -11).Value = Me.MobilePh.Value
    c.Offset(0, -10).Value = Me.FaxNum.Value
    c.Offset(0, -9).Value = Me.EmailAdd.Value
    c.Offset(0, -8).Value = Me.BldgType.Value
    c.Offset(0, -7).Value = Me.JobDisc.Value
    c.Offset(0, -6).Value = Me.Notes.Value
    c.Offset(0, -5).Value = Me.WallColor.Value
    c.Offset(0, -4).Value = Me.RoofColor.Value
    c.Offset(0, -3).Value = Me.Stage.Value
    c.Offset(0, -2).Value = Me.Completed.Value
    c.Offset(0, -1).Value = Me.ProsNum.Value
    c.Value = Me.JobNum.Value
    c.Offset(0, 1).Value = Me.ThankYouSent.Value
    c.Offset(0, 2).Value = Me.ThankYouDate.Value
    c.Offset(0, 3).Value = Me.SurveySent.Value
    c.Offset(0, 4).Value = Me.SurveyDate.Value
    c.Offset(0, 5).Value = Me.ReferralSent.Value
    c.Offset(0, 8).Value = Me.Canceled.Value

    End If
    
    'restore Form
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        ClearControls
        .Height = frmHt
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("A1").AutoFilter
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub


Private Sub ClearForm_Click()
    Call UserForm_Initialize
End Sub


Private Sub ListBox1_Click()

    If Me.ListBox1.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    ElseIf Me.ListBox1.ListIndex >= 1 Then    'User has selected
        r = Me.ListBox1.ListIndex

        With Me
            .CustName.Value = ListBox1.List(r, 0)
            .TerMgr.Value = ListBox1.List(r, 1)
            .CompName.Value = ListBox1.List(r, 2)
            .JobTitle.Value = ListBox1.List(r, 3)
            .MailAdd2.Value = ListBox1.List(r, 4)
            .EstCost.Value = ListBox1.List(r, 5)
            .SoldDate.Value = ListBox1.List(r, 6)
            .MailAdd1.Value = ListBox1.List(r, 7)
            .SiteAdd1.Value = ListBox1.List(r, 8)
            .SiteAdd2.Value = ListBox1.List(r, 9)
            .HomePh.Value = ListBox1.List(r, 10)
            .WorkPh.Value = ListBox1.List(r, 11)
            .MobilePh.Value = ListBox1.List(r, 12)
            .FaxNum.Value = ListBox1.List(r, 13)
            .EmailAdd.Value = ListBox1.List(r, 14)
            .BldgType.Value = ListBox1.List(r, 15)
            .JobDisc.Value = ListBox1.List(r, 16)
            .Notes.Value = ListBox1.List(r, 17)
            .WallColor.Value = ListBox1.List(r, 18)
            .RoofColor.Value = ListBox1.List(r, 19)
            .Stage.Value = ListBox1.List(r, 20)
            .Completed.Value = ListBox1.List(r, 21)
            .ProsNum.Value = ListBox1.List(r, 22)
            .JobNum.Value = ListBox1.List(r, 23)
            .ThankYouSent.Value = ListBox1.List(r, 24)
            .ThankYouDate.Value = ListBox1.List(r, 25)
            .SurveySent.Value = ListBox1.List(r, 26)
            .SurveyDate.Value = ListBox1.List(r, 27)
            .ReferralSent.Value = ListBox1.List(r, 28)
            .Canceled = ListBox1.List(r, 31)

            .cmbAmend.Enabled = True      'allow amendment or
            .cmbDelete.Enabled = True     'allow record deletion
            .cmbAdd.Enabled = True       'don't want duplicate

        End With
    
        r = r - 1
    End If
End Sub

Private Sub UserForm_Initialize()
    Set MyData = Sheet1.Range("a1").CurrentRegion   'database
    With Me
        .Caption = "Add - Edit - Delete Prospects"    'userform caption
        .Height = frmHt
        .Width = frmWidth
    End With
    
    JobNum.Value = ""
    CustName.Value = ""
    CompName.Value = ""
    MailAdd1.Value = ""
    MailAdd2.Value = ""
    SiteAdd1.Value = ""
    SiteAdd2.Value = ""
    HomePh.Value = ""
    WorkPh.Value = ""
    MobilePh.Value = ""
    FaxNum.Value = ""
    EmailAdd.Value = ""
    JobTitle.Value = ""
    JobDisc.Value = ""
    With TerMgr
        .AddItem "Brad"
        .AddItem "Craig H"
        .AddItem "Don"
        .AddItem "Gregg"
        .AddItem "Keith"
        .AddItem "Ray"
        .AddItem "Rollie"
        .AddItem "Thad"
    End With
    TerMgr.Value = ""
    SoldDate.Value = ""
    EstCost.Value = ""
    With Completed
        .AddItem "No"
        .AddItem "Yes"
    End With
    Completed.Value = ""
    With Stage
        .AddItem "Prospect"
        .AddItem "Job Sold"
        .AddItem "Job Lost"
        .AddItem "Completed Job"
        .AddItem "Inactive"
        .AddItem "Canceled"
    End With
    Stage.Value = ""
    With BldgType
        .AddItem "Agricultural"
        .AddItem "Suburban Storage"
        .AddItem "Commercial"
        .AddItem "Hangar"
        .AddItem "Dairy"
        .AddItem "Equestrian"
        .AddItem "Retrofit/Repairs/TM"
        .AddItem "Material Package"
        .AddItem "Other"
    End With
    BldgType.Value = ""
    Notes.Value = ""
    With WallColor
        .AddItem "Bright White (39)"
        .AddItem "White (30)"
        .AddItem "Red (24)"
        .AddItem "Patriot Red (73)"
        .AddItem "Mocha Tan (22)"
        .AddItem "Ivory (28)"
        .AddItem "Brown (12)"
        .AddItem "Burgundy (15)"
        .AddItem "Carlsbad Canyon (10)"
        .AddItem "Light Stone (63)"
        .AddItem "Fern Green (07) (low glass)"
        .AddItem "Taupe (74)"
        .AddItem "Burnished Slate (49)"
        .AddItem "Zinc Grey (29)"
        .AddItem "Charcoal (17)"
        .AddItem "Ash Grey (25)"
        .AddItem "Black (06)"
        .AddItem "Hawaiian Blue (70)"
        .AddItem "Ocean Blue (35)"
        .AddItem "Native Copper (95) (premium color)"
    End With
    WallColor.Value = ""
    With RoofColor
        .AddItem "Bright White (39)"
        .AddItem "White (30)"
        .AddItem "Red (24)"
        .AddItem "Patriot Red (73)"
        .AddItem "Mocha Tan (22)"
        .AddItem "Ivory (28)"
        .AddItem "Brown (12)"
        .AddItem "Burgundy (15)"
        .AddItem "Carlsbad Canyon (10)"
        .AddItem "Light Stone (63)"
        .AddItem "Fern Green (07) (low glass)"
        .AddItem "Taupe (74)"
        .AddItem "Burnished Slate (49)"
        .AddItem "Zinc Grey (29)"
        .AddItem "Charcoal (17)"
        .AddItem "Ash Grey (25)"
        .AddItem "Black (06)"
        .AddItem "Hawaiian Blue (70)"
        .AddItem "Ocean Blue (35)"
        .AddItem "Native Copper (95) (premium color)"
    End With
    RoofColor.Value = ""
    With ThankYouSent
        .AddItem "No"
        .AddItem "Yes"
        .AddItem "Not Needed"
    End With
    ThankYouSent.Value = ""
    With SurveySent
        .AddItem "No"
        .AddItem "Yes"
        .AddItem "Not Needed"
    End With
    SurveySent.Value = ""
    With ReferralSent
        .AddItem "No"
        .AddItem "Yes"
        .AddItem "Not Needed"
    End With
    ReferralSent.Value = ""
    ThankYouDate.Value = ""
    SurveyDate.Value = ""
    ProsNum.Value = ""
    JobNum.Value = ""
    With Canceled
        .AddItem "No"
        .AddItem "Yes"
    End With
    Canceled.Value = ""



End Sub


Sub ClearControls()
    With Me
        For Each oCtrl In .Controls
            Select Case TypeName(oCtrl)
                Case "TextBox": oCtrl.Value = Empty
                Case "OptionButton": oCtrl.Value = False
            End Select
        Next oCtrl
    End With
End Sub

 

[xenou]

Hi,

Your find algorithms all seem to exhibit a common snafu:
Set rng = Sheet1.Range("a1", Range("a65536").End(xlUp))

This is incorrect and should be:

Set rng = Sheet1.Range("a1", [COLOR="#FF0000"]Sheet1.[/COLOR]Range("a65536").End(xlUp))

Or alternatively (with both range properties dotted to chain them to Sheet 1 using a With block):

With Sheet1
    Set rng = .Range("a1", .Range("a65536").End(xlUp))
End With

Actually I think it really should be -- with Range("A1") rather than just "A1" -- :

Set rng = Sheet1.Range(Sheet1.Range("A1"), Sheet1.Range("a65536").End(xlUp))

Or alternatively (with both range properties dotted to chain them to Sheet 1 using a With block):

With Sheet1
    Set rng = .Range(.Range("A1"), .Range("a65536").End(xlUp))
End With

I'd go through and make these changes - hopefully that's the problem (hard to say with so much code - surprised that it worked before but maybe you were lucky in that the user typically had the right worksheet active all the time based on their work habits. If VBA is not something you are experienced with and this is a critical application it may be something to give to a consultant for cleanup.

HTH,
ξ

 

[Juan V Gomez]

It magically started working again like 4:30 yesterday afternoon. This morning I copied the code to a different file for a different division of the company (same system just a few different fields) and it crapped out again. I added xenou's code and it did start working again, but one, I don't trust it to keep working (not cause of xenou, but cause that's been the way this program has run) and two, now I'm finding the problem that when you find multiple entries and amend one of the records, it just amends the top record vs the one you selected.

Basically I really do need a professional to read over my code. If my company was willing to pay for a consultant, they wouldn't be paying me to do this in the first place. I can plug him on it again, but I'm kinda in a box (hence why I've turned to here for help).

 

[xenou]

It's a lot of code here, and to debug it properly it would probably be necessary to be aware of the structure of the data file you are updating, as well as (possibly) the design of the userform that is being used in this process. Offhand, it seems like too much for me to do for you, though I can try to offer more tips. I probably wouldn't use Excel as a database in the first place, though. Another question from your last post is what do you mean by multiple entries? Are these duplicates? If your data allows for multiple entries but your search only finds the first one then there's a lot to fix here.

 

[Juan V Gomez]

I'd like to not be using excel as the main database, but they don't have access installed on any of the computers. Further more, some of the Territory Managers barely know how to use a mouse, let alone getting into Access.

What I meant by multiple entries, is if Bob Smith did 3 projects with us, or there are 2 different Bob Smiths who have done business with us, they are separate entries in the database. So when you search by Customer Name for Bob Smith it finds them all (and that generally works). So the search is finding all the entries. The issue I came across this morning was that even when you selected the 3rd entry of Bob Smith, when you clicked the Amend button it amended the first record rather than the 3rd.

Really this thing is largely turning into a cluster**** (and reminding me why I never got into computer programing when I got out of undergrad). I by no means expect you (xenou) or anyone else to take the time to go over the whole code. If someone did, I wouldn't stop them, but I'm not expecting or asking for it. More venting about being stuck largely on my own doing this. It's been a rough couple of days. I need beer.

 

[xenou]

Well in a nutshell (if I read the code right) you're function will just find the first customer that matches (on name?). So there's no instruction in the code that checks if its the "right" customer or not (i.e., should be a customer of the same name but on a different row). How would you think it best to determine which row to go to - by just counting down, or is there some way to identify the row more completely (such as by customer + project number or some other such "ID").