I have a data entry form for inputting lost and found items into a worksheet, I'm able to search the items but I have a list box for recent entries but obviously the first row is the first item on the list box, is there someway that I can sort rows from the page to the most recent entry by clicking the submit button?
Private Sub Submit_Button_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Found_Property")
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
'validation-----------------------------------------------------
If Me.Date_Item_Found_Textbox.Value = "" Then
MsgBox "Please enter the date the item was found.", vbCritical
Exit Sub
End If
If Me.Property_Owner_Textbox.Value = "" Then
MsgBox "Please enter the name of the owner of the property, if not available
enter N/A.", vbCritical
Exit Sub
End If
If Me.Location_Found_Combobox.Value = "" Then
MsgBox "Please select a location the item was found.", vbCritical
Exit Sub
End If
If Me.Property_Description_Textbox.Value = "" Then
MsgBox "Please enter a breif description of the item.", vbCritical
Exit Sub
End If
If Me.Reporting_Officer_Combobox.Value = "" Then
MsgBox "Please select your name or the reporting officer's name.", vbCritical
Exit Sub
End If
If Me.Contact_Number_Textbox.Value = "" Then
MsgBox "Please enter a valid contact number for the reporting party.",
vbCritical
Exit Sub
End If
If Me.Location_Stored_Combobox.Value = "" Then
MsgBox "Please select the location of which the item is stored.", vbCritical
Exit Sub
End If
'---------------------------------------------------------------
sh.Range("A" & last_row + 1).Value = "=Row()-2"
sh.Range("B" & last_row + 1).Value = Me.Date_Item_Found_Textbox.Value
sh.Range("D" & last_row + 1).Value = Me.Property_Owner_Textbox.Value
sh.Range("E" & last_row + 1).Value = Me.Contact_Number_Textbox.Value
sh.Range("F" & last_row + 1).Value = Me.Location_Found_Combobox.Value
sh.Range("G" & last_row + 1).Value = Me.Property_Description_Textbox.Value
sh.Range("H" & last_row + 1).Value = Me.Reporting_Officer_Combobox.Value
sh.Range("I" & last_row + 1).Value = Me.Location_Stored_Combobox.Value
sh.Range("J" & last_row + 1).Value = Now
'---------------------------------------------------------------
Me.ID_Textbox = ""
Me.Date_Item_Found_Textbox = ""
Me.Property_Owner_Textbox = ""
Me.Contact_Number_Textbox = ""
Me.Location_Found_Combobox = ""
Me.Property_Description_Textbox = ""
Me.Reporting_Officer_Combobox = ""
Me.Location_Stored_Combobox = ""
'-----
MsgBox "The item has been successfully entered as FOUND PROPERTY"
Call refresh_data
Me.Date_Item_Found_Textbox.SetFocus
Dim mycell As Range
Dim myrange As Range
Set myrange = Worksheets("Found_Property").Range("A3:J100")
For Each mycell In myrange
mycell.Value = UCase(mycell.Value)
Next mycell
End Sub
The script is running in Citrix VDI login, but it is getting an error in AWS login. I tried all the options as per Stack Overflow guidance and still the issue is coming.
Here is the code:
This particular code will copy the data from the input sheets and extract the data in new workbook with five individual tabs.
Dim CurBookName As String
Dim NewBookName As String
Dim sServerName As String
Private Sub CheckBox1_Change()
'If checkbox is checked, all the products in the listbox will be selected. If checkbox is unchecked
'all the products in the listbox will be deselected.
If CheckBox1.Value = True Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next
ElseIf CheckBox1.Value = False Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next
End If
End Sub
Private Sub CommandButton1_Click()
'This code creates new Workbook and adds required Worksheets to it
On Error GoTo errHandler
Dim i As Integer, j As Integer
Dim bSelFlag As Boolean
Dim sFormula As String
Dim sVersion As String
Dim sPath As String
Dim sRepVerVal As String, sComVerVal As String
bSelFlag = False
For j = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(j) = True Then
bSelFlag = True
Exit For
End If
Next j
If bSelFlag = False Then
MsgBox "Please select one or more products from the product list"
Exit Sub
End If
CurBookName = ActiveWorkbook.name
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
SetMenuParameters (i)
' 1. Create blank workbook
' 2. Copy all format to new workbook
' 3. Copy all value to new workbook
Workbooks.Add
NewBookName = ActiveWorkbook.name
Workbooks(NewBookName).Worksheets.Add().name = "Total Summary"
Workbooks(NewBookName).Worksheets.Add().name = "Flow"
Workbooks(NewBookName).Worksheets.Add().name = "Variance"
Workbooks(NewBookName).Worksheets.Add().name = "TBA"
Workbooks(NewBookName).Worksheets.Add().name = "Percentage"
Workbooks(NewBookName).Worksheets.Add().name = "Total"
Application.DisplayAlerts = False
Workbooks(NewBookName).Worksheets("sheet1").Delete
Workbooks(NewBookName).Worksheets("sheet2").Delete
Workbooks(NewBookName).Worksheets("sheet3").Delete
Application.DisplayAlerts = True
Windows(CurBookName).Activate
Application.StatusBar = "Please wait....Copy Process is in progress for the Product '" & ListBox1.List(i) & "' ..."
CopySheet "Total Input", "Total"
CopySheet "Price Input", "Percentage"
TBA_Built = False
CopySheet "TBA", "TBA"
Var_Built = False
CopySheet "Variance", "Variance"
CF_Built = False
CopySheet "Flow", "Flow"
CopySheet "Total Summary", "Total Summary"
sVersion = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Value
sPath = "\\user\shunt\"
If val(Application.Version) > 11 Then
Call Hide_Rows_Snapshot(NewBookName, "Percentage")
NewBookName = "TM1 " & ListBox1.List(i) & " TBA (" & sVersion & ")_" & Format(Now(), "MMDDYYHHMMSS") & ".xlsx"
ElseIf val(Application.Version) = 11 Then
NewBookName = "TM1 " & ListBox1.List(i) & " TBA (" & sVersion & ")_" & Format(Now(), "MMDDYYHHMMSS") & ".xls"
End If
ActiveWorkbook.SaveAs filename:=sPath & Replace(NewBookName, "/", "_")
ActiveWindow.Close
End If
Next
MsgBox "Copy Process has been done successfully!" & vbCrLf & vbCrLf & "Please find the Snapshots at " & sPath
Application.StatusBar = ""
Exit Sub
errHandler:
MsgBox Err.Description
End Sub
Private Sub Worksheet_Activate()
'This code populates TBA products
Dim iMonth As Integer, iYear As Integer, sYear As Integer
Dim sMonth As String, sVersion As String, sVerFormula As String
Dim sVarVersion As String, sVarVerFormula As String
PopulateProducts
iYear = Format(Date, "yyyy")
sMonth = Format(Date, "mmm")
sMonthnum = Month(Date)
If sMonth = "Jan" Or sMonth = "Apr" Or sMonth = "Jul" Or sMonth = "Oct" Then
sMonthnum = sMonthnum + 1
sYear = iYear
ElseIf sMonth = "Mar" Or sMonth = "Jun" Or sMonth = "Sep" Then
sMonthnum = sMonthnum + 2
sYear = iYear
ElseIf sMonth = "Dec" Then
sMonthnum = sMonthnum - 10
iYear = iYear + 1
sYear = iYear
Else
sMonthnum = sMonthnum
sYear = iYear
End If
sMonth = MonthName(sMonthnum, True)
sVersion = sMonth & "_" & Mid(CStr(iYear), 3, 2) & "_Forecast"
'Setting default values to Report Parameters
Worksheets("CreateSnapshot").Cells(9, 8) = sVersion
sServerName = Worksheets("Globals").Range("Server_Name").Value
sVerFormula = "SUBNM(" & """" & sServerName & ":Version""" & "," & """" & """,""" & sVersion & """)"
Worksheets("CreateSnapshot").Cells(9, 8).Formula = "=" & sVerFormula
Worksheets("CreateSnapshot").Cells(10, 8) = Format(Date, "yyyy") - 1
'Setting default values to Variance Parameters
iMonth = Month(Now)
iYear = Year(Now)
iYear = Format(Date, "yyyy")
iMonth = sMonthnum
If iMonth = 2 Then
If iYear <> sYear Then
iMonth = 11
Else
iMonth = 11
iYear = iYear - 1
End If
Else
iMonth = iMonth - 3
End If
sVarVersion = MonthName(iMonth, True) & "_" & Mid(CStr(iYear), 3, 2) & "_Forecast"
Worksheets("CreateSnapshot").Cells(9, 11) = sVarVersion
sVarVerFormula = "SUBNM(" & """" & sServerName & ":Version""" & "," & """" & """,""" & sVarVersion & """)"
Worksheets("CreateSnapshot").Cells(9, 11).Formula = "=" & sVarVerFormula
End Sub
Public Sub PopulateProducts()
'The listbox is populated with Products from TBA_Products subset
Dim SubsetSize As Integer, i As Integer
Dim ElName As String
SubsetSize = Application.Run("SUBSIZ", ThisWorkbook.Worksheets(GLOBALS).Range("Server_Name") & ":Product", "TBA_Products")
ListBox1.Clear
i = 1
While i <= SubsetSize
ElName = Application.Run("SUBNM", ThisWorkbook.Worksheets(GLOBALS).Range("Server_Name") & ":Product", "TBA_Products", i, "Description")
ListBox1.AddItem (ElName)
i = i + 1
Wend
ListBox1.Height = 220
ListBox1.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub CopySheet(SourceSheetName As String, TargetSheetName As String)
'This code copies all the data from source workbook to target workbook
Dim ProdName As String
On Error Resume Next
Application.ScreenUpdating = False
Workbooks(CurBookName).Worksheets(SourceSheetName).Activate
Workbooks(CurBookName).Worksheets(SourceSheetName).Cells.Copy
Workbooks(NewBookName).Worksheets(TargetSheetName).Activate
Workbooks(NewBookName).Worksheets(TargetSheetName).Cells(1, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Workbooks(NewBookName).Worksheets(TargetSheetName).Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Workbooks(CurBookName).Worksheets(SourceSheetName).Range("B2").CopyPicture xlScreen, xlBitmap
ProdName = Workbooks(CurBookName).Worksheets(MENU).Range("Input_Product").Value
Workbooks(CurBookName).Worksheets(SourceSheetName).Shapes(ProdName).Copy
Workbooks(NewBookName).Worksheets(TargetSheetName).Range("B1:B3").PasteSpecial
Worksheets(TargetSheetName).Shapes(ProdName).Left = Worksheets(TargetSheetName).Columns("B").Left
Worksheets(TargetSheetName).Shapes(ProdName).Top = Worksheets(TargetSheetName).Rows(1).Top
Worksheets(TargetSheetName).Shapes(ProdName).Height = Worksheets(TargetSheetName).Rows(4).Top - Worksheets(TargetSheetName).Rows(1).Top
ActiveWindow.Zoom = 70
Workbooks(NewBookName).Worksheets(TargetSheetName).Columns("A").Hidden = True
Workbooks(NewBookName).Worksheets(TargetSheetName).Range("E1").Select
Application.ScreenUpdating = True
End Sub
Public Sub SetMenuParameters(iVal As Integer)
'Input parameters and Report parameters are being set here
'Input Parameters
sServerName = Worksheets("Globals").Range("Server_Name").Value
Workbooks(CurBookName).Worksheets("Menu").Range("Input_Product").Value = ListBox1.List(iVal)
sFormula = "SUBNM(" & """" & sServerName & ":Product""" & "," & """TBA_Products""" & "," & iVal + 1 & "," & """Description""" & ")"
Workbooks(CurBookName).Worksheets("Menu").Cells(8, 4).Formula = "=" & sFormula
Workbooks(CurBookName).Worksheets("Menu").Cells(5, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(5, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(6, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(6, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(7, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(7, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(9, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(10, 8).Value
'Report Parameters
Workbooks(CurBookName).Worksheets("Menu").Range("Report_Product").Value = ListBox1.List(iVal)
sFormula = "SUBNM(" & """" & sServerName & ":Product""" & "," & """TBA_Products""" & "," & iVal + 1 & ", " & """Description""" & " )"
Workbooks(CurBookName).Worksheets("Menu").Cells(19, 4).Formula = "=" & sFormula
Workbooks(CurBookName).Worksheets("Menu").Cells(16, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(16, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(17, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(17, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(18, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Value
Workbooks(CurBookName).Worksheets("Menu").Cells(18, 4).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 8).Formula
Workbooks(CurBookName).Worksheets("Menu").Cells(20, 4).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(10, 8).Value
'Variance Parameters
Var_Built = True
Workbooks(CurBookName).Worksheets("Variance").Cells(4, 8).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 11).Value
Workbooks(CurBookName).Worksheets("Variance").Cells(4, 8).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(7, 11).Formula
Workbooks(CurBookName).Worksheets("Variance").Cells(5, 8).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 11).Value
Workbooks(CurBookName).Worksheets("Variance").Cells(5, 8).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(8, 11).Formula
Workbooks(CurBookName).Worksheets("Variance").Cells(6, 8).Value = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 11).Value
Workbooks(CurBookName).Worksheets("Variance").Cells(6, 8).Formula = Workbooks(CurBookName).Worksheets("CreateSnapshot").Cells(9, 11).Formula
End Sub
Private Sub Hide_Rows_Snapshot(NewBookName As String, TargetSheetName As String)
Dim UsedRows As Integer
Dim UseRange As String
Workbooks(NewBookName).Activate
With ActiveWorkbook
UsedRows = .Worksheets(TargetSheetName).UsedRange.Rows.Count
UseRange = "A1:A" & Trim(str(UsedRows))
For Each c In .Worksheets(TargetSheetName).Range(UseRange).Cells
If c.Value = "hide" Then
.Worksheets(TargetSheetName).Rows(c.Row).Hidden = True
Else
.Worksheets(TargetSheetName).Rows(c.Row).Hidden = False
End If
Next
End With
End Sub
All Subscript Out of Range means is that your array doesn't have the member you are requesting.
dim v(5) as variant
v(0) = 'dog'
v(1) = 'cat'
v(2) = 'fish'
v(3) = 42
v(4) = 3.14
debug.print v(4) // Output is 3.14
debug.print v(5) //Throws Subscript out of range error.
I want to create a userform with inputs: Name (TextBox1), Surname (TextBox2), Date of birth (TextBox3) and 1 output which would basically be their ID (goes from 1 to inf). What bothers me is that I want to code that if lets say Name and Surname already exists in database, msg will popup and form will reset else everything will be put to the table. I kind of managed to do that. Problem is now if I do put name and surname that already exists it wont input it in the table and it will show the message, but even if it doesn't exists the message will still pop up but it will input it in the table. This is the code:
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Sheet2
Dim a As Integer
Application.ScreenUpdating = False
iRow = ws.Range("A1048576").End(xlUp).Row + 1
If Not (TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "") Then
With ws
Label1.Caption = iRow - 1
For a = 1 To iRow
If (ws.Cells(a, 2).Value = TextBox1.Value And ws.Cells(a, 3).Value = TextBox2.Value) Then
MsgBox "Values you entered already exists!"
Call Reset
Exit Sub
Else
.Range("A" & iRow).Value = Label1.Caption
.Range("B" & iRow).Value = TextBox1.Value
.Range("C" & iRow).Value = TextBox2.Value
.Range("D" & iRow).Value = TextBox3.Value
End If
Next a
End With
End If
Application.ScreenUpdating = True
End Sub
The problem is you are checking down to the row where the new record is inserted. So for every row that does not match the new record is inserted at iRow. When the loop gets to the end it checks iRow, matches and shows the message. Separate code into 2 steps, first check then update or reset.
Private Sub CommandButton1_Click()
If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "" Then
Exit Sub
End If
Dim ws As Worksheet
Dim iRow As Long, r As Long, bExists As Boolean
Set ws = Sheet2
iRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' check exists
For r = 1 To iRow
If (ws.Cells(r, 2).Value = TextBox1.Value) _
And (ws.Cells(r, 3).Value = TextBox2.Value) Then
bExists = True
Exit For
End If
Next
' update sheet
If bExists Then
MsgBox "Values you entered already exists!"
Call Reset
Exit Sub
Else
Label1.Caption = iRow
iRow = iRow + 1
With ws
.Range("A" & iRow).Value = Label1.Caption
.Range("B" & iRow).Value = TextBox1.Value
.Range("C" & iRow).Value = TextBox2.Value
.Range("D" & iRow).Value = TextBox3.Value
End With
End If
End Sub
I'm trying to set a "Make Changes" button for my userform that changes the appropriate record in the spreadsheet according to any changes made in the userform.
The userform populates according to the selection made on "BusCombo".
I'm trying to set n to the row of the "BusCombo" selection. I found a suggestion to use ListIndex. I can't find information on how ListIndex works.
Private Sub MkChgButton_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Customers")
Dim n
With Me.BusCombo
n = .ListIndex
End With
''''''submit changes
sh.Range("A" & n).Value = Me.BusCombo.Value
sh.Range("B" & n).Value = Me.ServFreqCombo.Value
sh.Range("K" & n).Value = Me.TimeText.Value
sh.Range("C" & n).Value = Me.RateText.Value
sh.Range("D" & n).Value = Me.PayFormCombo.Value
sh.Range("E" & n).Value = Me.PayFreqCombo.Value
sh.Range("F" & n).Value = Me.DayText.Value
sh.Range("G" & n).Value = Me.StartText.Value
sh.Range("H" & n).Value = Me.PayDateText.Value
sh.Range("I" & n).Value = Me.EmpCombo.Value
End Sub
Here's a little demo that shows you how to search through the List items in the Combobox:
Option Explicit
Private Sub UserForm_Initialize()
' add items to the combobox
With ComboBox1
.AddItem ("stuff1")
.List(0, 1) = "test1"
.AddItem ("stuff2")
.List(1, 1) = "test2"
.AddItem ("stuff3")
.List(2, 1) = "test3"
End With
End Sub
Private Sub CommandButton1_Click()
Dim i As Integer
Dim SearchString As String
SearchString = "test3"
' loop through all the items, looking in the 2nd column (column index=1)
For i = 0 To ComboBox1.ListCount - 1
If ComboBox1.List(i, 1) = SearchString Then
MsgBox ("Found it at row index " & i)
Exit Sub
End If
Next
MsgBox SearchString & " not found"
End Sub
I'm trying to build a check in my code, with the user input in a textbox, I'm trying to use a vlookup in previous records in a table to check if that unique value as already been used (initialized).
The target range "erpLots" contains text formatted cells, amd after checking using the VarType() function I know that assigning vValue = SpecEntry.TextBox3.Value vValue is a string type, the error that I'm getting "Type missmatch" is when doing the vlookup If Application.VLookup(vValue, erpLots, 1, False) = SpecEntry.TextBox3.Value Then.
I have a hunch that the error revolves around a type missmatch between the value being searched "vValue" and the target range "erpLots".
Here is the code:
Public intA As Integer
Public foundRow As Double
Sub StartButtonClick()
Dim rowCount As Long
Dim ws As Worksheet
Dim stg As String
Dim erpLots As Range
Dim vValue As Variant
Set erpLots = Worksheets("Inspection Data").Range("C2", Range("C2").End(xlDown))
Set ws = Worksheets("Inspection Data")
rowCount = ws.Range("A111111").End(xlUp).Row
'Checking the userform request info is complete
If Trim(SpecEntry.TextBox1.Value) = vbNullString Then
MsgBox "Please enter Operator ID"
ElseIf Trim(SpecEntry.TextBox2.Value) = vbNullString Then
MsgBox "Please scan or enter spec. number."
ElseIf Trim(SpecEntry.TextBox3.Value) = vbNullString Then
MsgBox "Please scan or enter ERP Lot #."
Else
SpecEntry.TextBox1.Value = UCase(SpecEntry.TextBox1.Value)
SpecEntry.TextBox2.Value = UCase(SpecEntry.TextBox2.Value)
SpecEntry.TextBox3.Value = UCase(SpecEntry.TextBox3.Value)
'checking if ERP Lot # already exist in the list
vValue = SpecEntry.TextBox3.Value
MsgBox "vValue is: " & vValue
If Application.VLookup(vValue, erpLots, 1, False) = SpecEntry.TextBox3.Value Then
foundRow = WorksheetFunction.Match(SpecEntry.TextBox3.Value, erpLots, 1)
Range("G" & foundRow).Value = Now()
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "h:mm"
Range("H" & foundRow).Value = Range("H" & foundRow).Value * 1440
Range("H" & foundRow).NumberFormat = "000.00"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.Count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).Value = SpecEntry.TextBox2.Value
.Offset(rowCount, 2).Value = SpecEntry.TextBox3.Value
.Offset(rowCount, 3).Value = Now()
End With
End If
End If
End Sub
My goal is that if the value exist, the information being captured is to be recorded in the same row but different columns, if the value does not exist, the information would become a new record.
If your Application.match() is working, why not dropthe vloopkup and just:
foundRow = Application.Iferror(WorksheetFunction.Match(SpecEntry.TextBox3.Value, erpLots, 1),0)
Then your If statement is:
If foundRow > 0 Then
Range("G" & foundRow).Value = Now()
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "h:mm"
Range("H" & foundRow).Value = Range("H" & foundRow).Value * 1440
Range("H" & foundRow).NumberFormat = "000.00"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.Count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).Value = SpecEntry.TextBox2.Value
.Offset(rowCount, 2).Value = SpecEntry.TextBox3.Value
.Offset(rowCount, 3).Value = Now()
End With
End If
I went with a countif, as a way to check if the input from the user existed in the target range, and then use that as a condition in the if statement.
Public intA As Integer
Public foundRow As Double
Sub StartButtonClick()
Dim rowCount As Long
Dim ws As Worksheet
Dim stg As String
Dim erpLots As Range
Dim vValue As Variant
Dim count As Integer
Set erpLots = Worksheets("Inspection Data").Range("C2", Range("C2").End(xlDown))
Set ws = Worksheets("Inspection Data")
foundRow = 0
count = 0
rowCount = ws.Range("A111111").End(xlUp).Row
'Checking the userform request info is complete
If Trim(SpecEntry.TextBox1.Value) = vbNullString Then
MsgBox "Please enter Operator ID"
ElseIf Trim(SpecEntry.TextBox2.Value) = vbNullString Then
MsgBox "Please scan or enter spec. number."
ElseIf Trim(SpecEntry.TextBox3.Value) = vbNullString Then
MsgBox "Please scan or enter ERP Lot #."
Else
SpecEntry.TextBox1.Value = UCase(SpecEntry.TextBox1.Value)
SpecEntry.TextBox2.Value = UCase(SpecEntry.TextBox2.Value)
SpecEntry.TextBox3.Value = UCase(SpecEntry.TextBox3.Value)
'checking if ERP Lot # already exist in the list and is coming back from labs
vValue = CStr(Trim(SpecEntry.TextBox3.Value))
count = Application.WorksheetFunction.CountIf(erpLots, vValue)
If count >= 1 Then
foundRow = Application.WorksheetFunction.Match(vValue, erpLots, 0) + 1
MsgBox "row to update is: " & foundRow
Range("G" & foundRow).Value = Now()
Range("G" & foundRow).NumberFormat = "mm/dd/yyyy hh:mm"
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "d " & Chr(34) & "days" & Chr(34) & " , h:mm:ss"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).NumberFormat = "#"
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).NumberFormat = "#"
.Offset(rowCount, 1).Value = CStr(SpecEntry.TextBox2.Value)
.Offset(rowCount, 2).NumberFormat = "#"
.Offset(rowCount, 2).Value = CStr(SpecEntry.TextBox3.Value)
.Offset(rowCount, 3).Value = Now()
End With
End If
End If
End Sub