its probably best to start off giving the whole of the code i have atm so it gives an idea of what im doing and how ive implemented it in 'add' but now struggling with the 'find' part
Now the part im struggling with is
its probably something simple that my head just cant get around tonight but any help would be great
Thanks
Tom
Code:
Dim MyData As Range
Dim c As Range
Dim rFound As Range
Dim r As Long
Dim rng As Range
Const frmMax As Long = 540
Const frmHt As Long = 540
Const frmWidth As Long = 480
'Dim sFileName As String 'image name
Dim oCtrl As MSForms.Control
Dim Cost As String
Dim Quantity As String
Dim TotalValue As String
Private Sub cmbAdd_Click()
'next empty cell in column A
Set c = Worksheets(ComboBox1.Value).Range("a65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False 'speed up, hide task
'write userform entries to database
With Me
c.Value = .TextBox3.Value 'column one is first name
c.Offset(0, 1).Value = .TextBox4.Value 'column 3 is department
c.Offset(0, 2).Value = .TextBox5.Value
c.Offset(0, 3).Value = .TextBox6.Value
c.Offset(0, 4).Value = .TextBox7.Value
c.Offset(0, 5).Value = .TextBox8.Value
c.Offset(0, 6).Value = .TextBox9.Value
c.Offset(0, 7).Value = .ComboBox2.Value
c.Offset(0, 8).Value = .TextBox11.Value
c.Offset(0, 9).Value = .TextBox12.Value
c.Offset(0, 10).Value = .TextBox13.Value
'Cost = TextBox9.Value
'Quantity = TextBox12.Value
'TotalValue = (Cost * Quantity)
c.Offset(0, 11).Value = Val(TextBox9.Text) * Val(TextBox13.Text)
ClearControls 'clear the form
End With
Application.ScreenUpdating = True 'updatescreen
End Sub
Sub ClearControls()
With Me
For Each oCtrl In .Controls
Select Case TypeName(oCtrl)
Case "TextBox": oCtrl.Value = Empty
End Select
Next oCtrl
End With
End Sub
Private Sub cmbFind_Click()
Dim strFind As String 'what to find
Dim FirstAddress As String
Dim rSearch As Range 'range to search
Set rSearch = Worksheets(ComboBox1.Value).Range("a4", Range("a65536").End(xlUp))
Dim f As Integer
imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
strFind = Me.ComboBox1.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
.TextBox3.Value = c.Offset(0, 1).Value
.cmbAmend.Enabled = True 'allow amendment or
.cmbDelete.Enabled = True 'allow record deletion
.cmbAdd.Enabled = False 'don't want to duplicate record
.TextBox4.Value = c.Offset(0, 3).Value
.TextBox5.Value = c.Offset(0, 4).Value
.TextBox6.Value = c.Offset(0, 5).Value
.combobox7.Value = c.Offset(0, 6).Value
.TextBox8.Value = c.Offset(0, 7).Value
.TextBox9.Value = c.Offset(0, 9).Value
.TextBox10.Value = c.Offset(0, 10).Value
.TextBox11.Value = c.Offset(0, 11).Value
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
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("A8").AutoFilter
End Sub
Private Sub UserForm_Initialize()
'Set MyData = Sheet1.Range("a5").CurrentRegion 'database
With Me
.Caption = "Damages Console" 'userform caption
.Height = frmHt
.Width = frmWidth
End With
ComboBox1.AddItem "January"
ComboBox1.AddItem "February"
ComboBox1.AddItem "March"
ComboBox1.AddItem "April"
ComboBox1.AddItem "May"
ComboBox1.AddItem "June"
ComboBox1.AddItem "July"
ComboBox1.AddItem "August"
ComboBox1.AddItem "September"
ComboBox1.AddItem "October"
ComboBox1.AddItem "November"
ComboBox1.AddItem "December"
ComboBox2.AddItem "Replenishment Issue"
ComboBox2.AddItem "Manufacturing Issue"
ComboBox2.AddItem "Manual Handling Issue"
ComboBox2.AddItem "Conveyor Issue Issue"
ComboBox2.AddItem "Location Issue"
ComboBox2.AddItem "Miscellaneous Issue"
End Sub
Sub FindAll()
Dim strFind As String 'what to find
Dim rFilter As Range 'range to search
Set rFilter = Worksheets(ComboBox1.Value).Range("a5", Range("a65536").End(xlUp))
Set rng = Worksheets(ComboBox1.Value).Range("a4", Range("a65536").End(xlUp))
strFind = Me.TextBox1.Value
With Sheet1
If Not .AutoFilterMode Then .Range("A5").AutoFilter
rFilter.AutoFilter Field:=1, Criteria1:=strFind
Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
Me.ListBox1.Clear
For Each c In rng
With Me.ListBox1
.AddItem c.Value
.List(.ListCount - 1, 1) = c.Offset(0, 1).Value
.List(.ListCount - 1, 2) = c.Offset(0, 2).Value
.List(.ListCount - 1, 3) = c.Offset(0, 3).Value
.List(.ListCount - 1, 3) = c.Offset(0, 3).Value
End With
Next c
End With
End SubNow the part im struggling with is
Code:
Private Sub cmbFind_Click()
Dim strFind As String 'what to find
Dim FirstAddress As String
Dim rSearch As Range 'range to search
Set rSearch = Worksheets(ComboBox1.Value).Range("a4", Range("a65536").End(xlUp)) ****This is where it stops working****
Dim f As Integer
imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
strFind = Me.ComboBox1.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
.TextBox3.Value = c.Offset(0, 1).Value
.cmbAmend.Enabled = True 'allow amendment or
.cmbDelete.Enabled = True 'allow record deletion
.cmbAdd.Enabled = False 'don't want to duplicate record
.TextBox4.Value = c.Offset(0, 3).Value
.TextBox5.Value = c.Offset(0, 4).Value
.TextBox6.Value = c.Offset(0, 5).Value
.combobox7.Value = c.Offset(0, 6).Value
.TextBox8.Value = c.Offset(0, 7).Value
.TextBox9.Value = c.Offset(0, 9).Value
.TextBox10.Value = c.Offset(0, 10).Value
.TextBox11.Value = c.Offset(0, 11).Value
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
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("A8").AutoFilter
End SubThanks
Tom