So this is what I have so far. I'm having a compiling issue when trying enter the hyperlink. Does anyone have any Ideas????
Option Explicit
Private Sub cmdexit_click()
Unload Me
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
'declare this variable at the top of the module
Dim fName As String
Sub Main_Routine()
Select_A_File
MsgBox fName
End Sub
Sub Select_A_File()
Dim sFile, I As Integer
'display dialog asking user to select a file
sFile = Application.GetOpenFilename _
("Files (*.jpg),*.jpg", , "Select A File")
'check to see if cancel selected in the box
If sFile = "False" Then
MsgBox "No file selected. Fault."
End
End If
fName = sFile
With sFile
sFile = txtpic1
End With
End Sub
Private Sub Edit_Click()
With Me
.txtmount1.BackColor = &H8000000F
.txtdate1.BackColor = &H8000000F
.txtdesc1.BackColor = &H8000000F
.txtnotes1.BackColor = &H8000000F
.txtengin1.BackColor = &H8000000F
.txtperf1.BackColor = &H8000000F
.txtprogram1.BackColor = &H80000005
.txtpic1.BackColor = &H80000005
.txtloc1.BackColor = &H80000005
.txt2date.BackColor = &H8000000F
.txtmount1.Locked = True
.txtdate1.Locked = True
.txtdesc1.Locked = True
.txtnotes1.Locked = True
.txtengin1.Locked = True
.txtperf1.Locked = True
.txtprogram1.Locked = False
.txtpic1.Locked = False
.txtloc1.Locked = False
.txt2date.Locked = True
.txt2date.Value = Date
End With
End Sub
Private Sub Find_Click()
Dim Nullstring
Application.ScreenUpdating = False
If fpolicy.Value = "" Or Nullstring Then
MsgBox "Please enter Mount Number"
GoTo error1:
End If
Worksheets("Data").Activate
Dim strFind
Dim rSearch As Range
Set rSearch = Worksheets("Data").Range("A2:A100000")
Dim c
strFind = fpolicy.Value
If strFind = Nullstring Then GoTo error1
With rSearch
Set c = .find(strFind, LookIn:=xlValues, MatchCase:=True)
If Not c Is Nothing Then
MsgBox strFind & " found", vbOKOnly
c.Select
Me.Height = 360
With Me
.txtmount1.Value = ActiveCell.Value
.txtdate1.Value = ActiveCell.Offset(0, 1).Value
.txtdesc1.Value = ActiveCell.Offset(0, 2).Value
.txtnotes1.Value = ActiveCell.Offset(0, 3).Value
.txtengin1.Value = ActiveCell.Offset(0, 4).Value
.txtperf1.Value = ActiveCell.Offset(0, 5).Value
.txtprogram1.Value = ActiveCell.Offset(0, 6).Value
.txtpic1.Value = ActiveCell.Offset(0, 7).Value
.txtloc1.Value = ActiveCell.Offset(0, 8).Value
.txt2date.Value = ActiveCell.Offset(0, 9).Value
End With
fpolicy.Locked = True
Else
Worksheets("Front Sheet").Activate
MsgBox "No exact match was found. Please try again"
End If
End With
error1:
Worksheets("Front Sheet").Activate
End Sub
Private Sub submit_Click()
If MsgBox("Are you sure you wish to update the inventory?", vbYesNo, "Confirm edit") = vbYes Then
Worksheets("Data").Activate
Dim strFind
Dim Nullstring
Dim rSearch As Range
Set rSearch = Sheet1.Range("A2:A1000000")
Dim c
strFind = fpolicy.Value
If strFind = Nullstring Then GoTo error1
With rSearch
Set c = .find(strFind, LookIn:=xlValues, MatchCase:=True)
If Not c Is Nothing Then
c.Select
ActiveCell.Value = txtmount1.Value
ActiveCell.Offset(0, 1).Value = txtdate1.Value
ActiveCell.Offset(0, 2).Value = txtdesc1.Value
ActiveCell.Offset(0, 3).Value = txtnotes1.Value
ActiveCell.Offset(0, 4).Value = txtengin1.Value
ActiveCell.Offset(0, 5).Value = txtperf1.Value
ActiveCell.Offset(0, 6).Value = txtprogram1.Value
ActiveCell.Offset(0, 7).Value = txtpic1.Value
ActiveCell.Offset(0, 8).Value = txtloc1.Value
ActiveCell.Offset(0, 9).Value = txt2date.Value
End If
End With
MsgBox "The Mount Inventory has sucessfully been updated", vbOKOnly
With Me
.fpolicy.Value = txtmount1.Value
.txtmount1.BackColor = &H8000000F
.txtdate1.BackColor = &H8000000F
.txtdesc1.BackColor = &H8000000F
.txtnotes1.BackColor = &H8000000F
.txtengin1.BackColor = &H8000000F
.txtperf1.BackColor = &H8000000F
.txtprogram1.BackColor = &H8000000F
.txtpic1.BackColor = &H8000000F
.txtloc1.BackColor = &H8000000F
.txt2date.BackColor = &H8000000F
.txtmount1.Locked = True
.txtdate1.Locked = True
.txtdesc1.Locked = True
.txtnotes1.Locked = True
.txtengin1.Locked = True
.txtperf1.Locked = True
.txtprogram1.Locked = True
.txtpic1.Locked = True
.txtloc1.Locked = True
.txt2date.Locked = True
End With
Else
End If
error1:
End Sub
Private Sub UserForm_Click()
End Sub
Bookmarks