I had everything working on an Excel 2003 machine, then I tested on a '97 machines and had some bugs. In trying to correct them (unsuccessfully) i have caused some issues with it running in 2003. Some of the machines running at my work are '97, some XP(2002), some 2003, and some 2007. I need this to work for everyone. I have attached the code, I can email the workbook with the userform and tables.
Code:
'Declare project variables
Dim CustomerStock As String
Dim csOpt As String
Dim soStat As String
Dim orderAge As String
Dim WorkbookName1 As String
Dim WorkbookName2 As String
Dim orderDelay As String
Dim Answer As Long
Dim ReportName As String
Dim soStatus As String
'Start project
Option Explicit
Private Sub CustomerOption3_Click() 'Customer option button - reports page
If SamsungForm.CustomerOption3.Value = True Then
SamsungForm.StockOption3.Value = False
csOpt = "Customer"
End If
End Sub
Private Sub delayNum_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'Validate user input as numeric
If Not IsNumeric(SamsungForm.delayNum.Value) And Not (SamsungForm.delayNum.Value = "") Then
SamsungForm.delayNum.Value = ""
Cancel = True
MsgBox "Value must be numeric", vbCritical, "Data entry error"
End If
orderDelay = SamsungForm.delayNum.Value
End Sub
Private Sub ageNum_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'Validate user input as numeric
If Not IsNumeric(SamsungForm.ageNum.Value) And Not (SamsungForm.ageNum.Value = "") Then
Set SamsungForm.ageNum.Value = ""
Cancel = True
MsgBox "Value must be numeric", vbCritical, "Data entry error"
End If
orderAge = SamsungForm.ageNum.Value
End Sub
Private Sub PrintAllButton_Click()
'Set Samsung Chart as WorkbookName1 variable
WorkbookName1 = "Samsung"
Windows(WorkbookName1).Activate
'Set Date format
Dim LValue As String
LValue = Format(Date, "mm.dd.yy")
'User input for filename
ReportName = InputBox(Prompt:="Enter Filename for Report.", Title:="Enter Filename", Default:="Samsung_Report_" & LValue)
'Test for existing filename
FILE_TEST: 'Label
Dim i As Integer
With Application.FileSearch
.NewSearch
.LookIn = "C:\Samsung Reports"
.SearchSubFolders = True
.Filename = ReportName
.MatchTextExactly = True
If .Execute() > 0 Then
ReportName = InputBox(Prompt:="Filename Already Exists." & vbCrLf & vbCrLf & "Enter Filename for Report.", Title:="Enter Filename", Default:="Samsung_Report_" & LValue & "_0001")
GoTo FILE_TEST
End If
End With
'Validate Criteria
If orderDelay = "" And SamsungForm.Status3.Value = "" And orderAge = "" And csOpt = "" Then
Answer = MsgBox("No Criteria Selected. Do you want to show all records?", vbYesNo + vbQuestion, "Export All?")
If Answer = vbNo Then
Exit Sub
End If
End If
'check for filter, turn on if none exists
If Not ActiveSheet.AutoFilterMode Then
Worksheets("Sheet1").Range("A1").AutoFilter
End If
'Declare LastRow variable
Dim LastRow As Long
'Locate last row of Tickets list and set as LastRow
LastRow = Worksheets("Sheet3").Range("A65536").End(xlUp).Row + 1
'Create new workbook (report)
Dim NewBook As Workbook
Dim rng As Range
Set NewBook = Workbooks.Add
'Save and name report
With NewBook
.Title = "Samsung Tickets - Report " & Now
.SaveAs Filename:="C:\Samsung Reports\" & ReportName & ".xls"
End With
'Create column headers
Range("A1") = "Job Number"
Range("B1") = "Ticket Number"
Range("C1") = "Customer/Stock"
Range("D1") = "Date In"
Range("E1") = "Age"
Range("F1") = "Delay"
Range("G1") = "Updated Date"
Range("H1") = "Status"
Range("I1") = "Notes"
'Set workbook name variable
WorkbookName2 = ActiveWorkbook.Name
'Activate Samsung Ticket list file
Windows(WorkbookName1).Activate
'Declare variables
Dim f As Range
Dim x As Range
'Set AutoFilter headers range
Set f = Sheet1.Range("A1:I1")
'Activate report file
Windows(WorkbookName2).Activate
'Set range for report
Set x = Worksheets("Sheet1").Range("A65536").End(xlUp)(2)
'Activate Samsung Ticket list file
Windows(WorkbookName1).Activate
'Pause screen updating
Application.ScreenUpdating = False
'Autofilter "With" statement
With f
'AutoFilter statements
If Not orderDelay = "" Then
Worksheets("Sheet1").UsedRange.AutoFilter Field:=6, Criteria1:=">" & orderDelay
End If
If Not SamsungForm.Status3.Value = "" Then
Worksheets("Sheet1").UsedRange.AutoFilter Field:=8, Criteria1:=SamsungForm.Status3.Text
End If
If Not csOpt = "" Then
Worksheets("Sheet1").UsedRange.AutoFilter Field:=3, Criteria1:=csOpt
End If
If Not orderAge = "" Then
Worksheets("Sheet1").UsedRange.AutoFilter Field:=5, Criteria1:=">" & orderAge
End If
'Copy results of filter
If IsEmpty(x) Then
'If Worksheets("Sheet1").UsedRange <> Then
'If Selection Is Nothing Then
MsgBox "No records found."
Exit Sub
End If
.Offset(1, 0).Resize(.CurrentRegion.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
'Paste results into report
x.PasteSpecial xlValues
'Reset Filters
.AutoFilter
End With
'Reset screen updating and cut/copy mode
With Application
.ScreenUpdating = True
.CutCopyMode = False
End With
'Format Report
'Activate report workbook
Windows(WorkbookName2).Activate
'Autofit columns and rows
Worksheets("Sheet1").Cells.EntireColumn.AutoFit
Worksheets("Sheet1").Cells.EntireRow.AutoFit
'Format dates in report
Worksheets("Sheet1").Range("D2").EntireColumn.NumberFormat = "mm/dd/yy"
Worksheets("Sheet1").Range("G2").EntireColumn.NumberFormat = "mm/dd/yy"
'Activate Samsung workbook, save, and close it
Windows(WorkbookName1).Activate
Windows(WorkbookName1).Close SaveChanges:=True
End Sub
Private Sub SaveButton1_Click() 'Save user input on new record page
'Activate Workbook and Sheet
Windows("Samsung").Activate
Sheets(1).Select
'Declare Variables
Dim LastRow As Long
'Identify last row
LastRow = Range("A65536").End(xlUp).Row + 1
'Prevent Duplication
If WorksheetFunction.CountIf(Range("A2", Cells(LastRow, 1)), Me.soNum.Text) > 0 Then
MsgBox "Duplicate Service Order Found", vbCritical
Exit Sub
End If
'Add name and time/date stamp
Notes.Text = Names1 & " " & Time & " " & Date & " " & Notes.Text
'Save values to table
Range("A" & LastRow).Value = soNum.Text
Range("B" & LastRow).Value = TicketNum.Text
Range("C" & LastRow).Value = CustomerStock
Range("D" & LastRow).Value = Date
Range("G" & LastRow).Value = Date
Range("H" & LastRow).Value = StatusCombo.Text
Range("I" & LastRow).Value = Notes
End Sub
Private Sub Status3_Change() 'Reports Page Status Box
'Set variable based on selection
'soStat = SamsungForm.Status3.Value
If SamsungForm.Status3.Value = "Evaluated" Then
soStat = "Evaluated"
End If
If SamsungForm.Status3.Value = "Pending Customer Response" Then
soStat = "Pending Customer Response"
End If
If SamsungForm.Status3.Value = "Parts Ordered" Then
soStat = "Parts Ordered"
End If
If SamsungForm.Status3.Value = "Scheduled" Then
soStat = "Scheduled"
End If
If SamsungForm.Status3.Value = "Completed" Then
soStat = "Completed"
End If
End Sub
Private Sub StockOption2_Click() 'Stock option button - update page
If SamsungForm.StockOption2.Value = True Then
SamsungForm.CustomerOption2.Value = False
csOpt = "Stock"
End If
End Sub
Private Sub StockOption3_Click() 'Stock option button - reports page
If SamsungForm.StockOption3.Value = True Then
SamsungForm.CustomerOption3.Value = False
csOpt = "Stock"
End If
End Sub
Private Sub UserForm_Terminate() 'Actions when closing userform
'removes AutoFilter if one exists
Worksheets("Sheet1").AutoFilterMode = False
End Sub
Private Sub ClearFormButton_Click() 'Clear All Fields
TicketNum2.Text = ""
CustomerOption2.Value = ""
StockOption2.Value = ""
DateIn2.Value = ""
DateUpdated2.Value = ""
StatusCombo2.Text = ""
NewNotes.Text = ""
ExistingNotes.Text = ""
soNum2.Value = ""
Names2.Value = ""
End Sub
Private Sub CustomerOption_Click() 'Customer option button - new record page
If SamsungForm.CustomerOption.Value = True Then
CustomerStock = "Customer"
SamsungForm.StockOption.Value = False
Else
CustomerStock = "Stock"
SamsungForm.StockOption.Value = True
End If
End Sub
Private Sub SaveFormButton_Click()
'Activate Samsung table
Windows("Samsung").Activate
Sheets(1).Select
'Declare variable
Dim soNumBAK As String
Dim LastRow As Long
Dim fnd1 As Range ' this will be the samew as your entry in SO# field
Dim tbl As Range ' this will be the table to search
'Set table range
Set tbl = Sheet1.Range("A2").CurrentRegion
'run the search
Set fnd1 = tbl.Find(What:=soNum2.Value, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'Validate notes entry
If NewNotes.Text = "" Then GoTo Update:
'Add name and time/date stamp to notes
NewNotes.Text = Names2 & " " & Time & " " & Date & " " & NewNotes.Text
Update: 'Label
'Update fields based on user input
fnd1.Offset(0, 0).Value = soNum2.Text
fnd1.Offset(0, 1).Value = TicketNum2.Text
If CustomerOption2.Value = True Then
fnd1.Offset(0, 2).Value = "Customer"
ElseIf StockOption2.Value = True Then
fnd1.Offset(0, 2).Value = "Stock"
End If
fnd1.Offset(0, 3).Value = DateIn2.Value
fnd1.Offset(0, 6).Value = Date
fnd1.Offset(0, 7).Value = SamsungForm.StatusCombo2.Value
If NewNotes.Text = "" Then
fnd1.Offset(0, 8).Value = ExistingNotes.Text
Else
fnd1.Offset(0, 8).Value = NewNotes.Text & vbCrLf & ExistingNotes.Text
End If
'Set alternate variable for SO#
soNumBAK = soNum2.Text
'Clear fields
soNum2.Text = ""
TicketNum2.Text = ""
CustomerOption2.Value = ""
StockOption2.Value = ""
DateIn2.Value = ""
DateUpdated2.Value = ""
StatusCombo2.Text = ""
NewNotes.Text = ""
ExistingNotes.Text = ""
Names2.Text = ""
'Re-insert SO#
soNum2.Text = soNumBAK
'Restart vb scripts
Application.Run soNum2
End Sub
Private Sub soNum2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Activate Samsung file and records sheet
Windows("Samsung").Activate
Sheets(1).Select
'Declare variables
Dim fnd1 As Range ' this will be the same as your entry in SO# Field
Dim tbl As Range ' this will be the table to search
'Set table range
Set tbl = Sheet1.Range("A2").CurrentRegion
'run the search
Set fnd1 = tbl.Find(What:=soNum2.Value, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'Validate fields is not empty
If fnd1 Is Nothing Then 'if the item is not found the user is informed and the textbox cleared
MsgBox "No match found!"
soNum2.Value = ""
Exit Sub
Else: fnd1.Activate 'if the item is found the details will be copied to the labels
End If
'Update fields with found result
TicketNum2.Text = fnd1.Offset(0, 1).Value
If fnd1.Offset(0, 2).Value = "Customer" Then
SamsungForm.CustomerOption2.Value = True
SamsungForm.StockOption2.Value = False
ElseIf fnd1.Offset(0, 2).Value = "Stock" Then
SamsungForm.CustomerOption2.Value = False
SamsungForm.StockOption2.Value = True
End If
StatusCombo2.Text = fnd1.Offset(0, 7).Value
DateIn2.Text = fnd1.Offset(0, 3).Value
Age2.Text = fnd1.Offset(0, 4).Value
UpdateAge2.Text = fnd1.Offset(0, 5).Value
DateUpdated2.Text = fnd1.Offset(0, 6).Value
ExistingNotes.Text = fnd1.Offset(0, 8).Value
End Sub
Private Sub StockOption_Click() 'Stock option button - new record page
If SamsungForm.StockOption.Value = True Then
CustomerStock = "Stock"
SamsungForm.CustomerOption.Value = False
Else
CustomerStock = "Customer"
SamsungForm.CustomerOption.Value = True
End If
End Sub
