I have a little problem, with my VBA code. I have made a userform, which has following:
Combobox1 is Sku number
Combobox2 is Test number
Combobox3 is Test result
Textbox is Comment_To_Result.
'Inserts comments og test result
Dim iRow, iCol
With ThisWorkbook.Worksheets("Data sheet")
iCol = Application.Match(CLng(ComboBox2.Value), .Columns("Q"), 0)
iCol = Application.Match(CLng(ComboBox1.Value), .Columns("A"), 0)
' If IsError(iRow) Then MsgBox "SKU not found": Exit Sub
' If IsError(iCol) Then MsgBox "Test number not found": Exit Sub
'Add test result/next step and comment
.Cells(iCol, 30).Value = Me.ComboBox3.Value
.Cells(iCol, 30 + 1).Value = Me.Comments_To_Result.Value
End With
I want the code to find sku number and test number and based on that, insert test result and comment i the same row. (SKU and test number is already in the sheet)
The code below is working fine, when the test number is 1, but when i try to change the test number to for example 2 or 3, the column code is debuggen. Does anybody know, what could be wrong?
Thanks in advance!
You are writing results in the same columns (30 and 31) regardless of the result of the search on the Test number column. You probably want this:
Dim iRow, iCol
With ThisWorkbook.Worksheets("Data sheet")
iRow = Application.Match(CLng(ComboBox1.Value), .Columns("A"), 0)
iCol = Application.Match(CLng(ComboBox2.Value), .Rows(17), 0)
If IsError(iRow) Then MsgBox "SKU not found": Exit Sub
If IsError(iCol) Then MsgBox "Test number not found": Exit Sub
'Add test result/next step and comment
.Cells(iRow, iCol).Value = Me.ComboBox3.Value
.Cells(iRow, iCol+1).Value = Me.Comments_To_Result.Value
End With
p.s.: Sincde the items searched for are numbers (integers), I converted the combo's values to numbers before searching them in the worksheet:
CLng(ComboBox1.Value) and CLng(ComboBox2.Value)
' ^^^^^ ^^^^^
Related
I have a User Form that searches a table column and returns all the values in the row as editable fields on the form. It works fantastic! But I wanted to add another column to the search. I would like to use the last 4 numbers of an 11 digit number so I created another column with a formula that returns the last 4 digits.
I set the variable with:
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[W/O]"), 0).
and it works fine. The column is filled with 6 digit numbers populated by this reference: =IFERROR(JobSheetData[#[W/O]],"").
However, when I change it to this:
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[Ticket Search]"), 0)
it will not find the row with the search value.
I have a column in the table that uses this reference =IFERROR(JobSheetData[#[ON1Call Ticket '#]],"") and then I have the column Ticket Search that contains the last 4 digits as mentioned above.
The W/O column that is searchable has every line filled with data but 40% of the Ticket Search column is blank. I tried removing values from the W/O column to see if that was the issue but it still worked.
Here is all the code:
Private Sub CommandButton1_Click()
Dim RecordRow As Long
Dim RecordRange As Range
Dim sChkBoxResult As String
' Turn off default error handling so Excel does not display
' an error if the record number is not found
On Error Resume Next
'Find the row in the table that the record is in
**This one works:**
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[W/O]"), 0)
**This one doesn't:**
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[Ticket Search]"), 0)
' Set RecordRange to the first cell in the found record
Set RecordRange = Range("JobSheet").Cells(1, 1).Offset(RecordRow - 1, 0)
' If an erro has occured i.e the record number was not found
If Err.Number <> 0 Then
ErrorLabel.Visible = True
On Error GoTo 0
Exit Sub
End If
' Turn default error handling back on (Let Excel handle errors from now on)
On Error GoTo 0
' If the code gets to here the record number was found
' Hide the error message 'Not Found'
ErrorLabel.Visible = False
' and populate the form fields with the record's data
TextBoxNameAddress.Value = RecordRange(1, 1).Offset(0, 3).Value & " - " & RecordRange(1, 1).Offset(0, 2).Value & " " & RecordRange(1, 1).Value
TextBoxHold.Value = RecordRange(1, 1).Offset(0, 5).Value
TextBoxDays.Value = RecordRange(1, 1).Offset(0, 7).Value
CheckBoxLocate.Value = RecordRange(1, 1).Offset(0, 9).Value
TextBoxCount.Value = RecordRange(1, 1).Offset(0, 11).Value
TextBoxFirst.Value = RecordRange(1, 1).Offset(0, 13).Value
TextBoxOveride.Value = RecordRange(1, 1).Offset(0, 14).Value
CheckBoxBell.Value = RecordRange(1, 1).Offset(0, 15).Value
CheckBoxGas.Value = RecordRange(1, 1).Offset(0, 16).Value
CheckBoxHydro.Value = RecordRange(1, 1).Offset(0, 17).Value
CheckBoxWater.Value = RecordRange(1, 1).Offset(0, 18).Value
CheckBoxCable.Value = RecordRange(1, 1).Offset(0, 19).Value
CheckBoxOther1.Value = RecordRange(1, 1).Offset(0, 20).Value
CheckBoxOther2.Value = RecordRange(1, 1).Offset(0, 21).Value
CheckBoxOther3.Value = RecordRange(1, 1).Offset(0, 22).Value
End Sub
UPDATE:
Here is a screenshot of some sample data:
The data starts in column A
My ultimate goal was to have an if statement that would run either the 6 digit search on the W/O column or the 4 digit search on the ON1Call Ticket # column based on the length of the string in TextBoxSearch Since they are either 4 digit or 6 digit, I thought I would base it on if the value was >9999 but the `ON1Call Ticket #' column is a text column and not numeric and the search fails.
When the first utility locate arrives the 10 or 11 digit ticket number is automatically added to the Job Sheet. As the emails arrive from the various utilities, the ticket number is always used for identification. I have an automation that extracts the Ticket number and saves the incoming locates as PDF files using the ticket number and some random characters characters as the file name. I have it set up to split the filename like this: 123456 7890 - jkes.pdf. A person now renames the file to indicate what utilities are included in that file and and uses the middle set of 4 numbers in the User Form:
to find the correct record and check the checkbox of the corresponding utility. I don't want the user to have to type all 11 digits and I was trying to avoid a helper column but I could not figure out how to make the 4 digit search look only at the last 4 digits of the ticket number.
At other times we need to search by the Work Order # which is 6 digits.
I would maybe do something like this:
Private Sub CommandButton1_Click()
Dim RecordRow As Variant '<<< not Long, or throws an error when no match
Dim vSearch As Long, col, lo As ListObject
Set lo = ThisWorkbook.Worksheets("Data").ListObjects("JobSheet") 'adjust sheet name
vSearch = CLng(TextBoxSearch.Value)
For Each col In Array("W/O", "Ticket Search") 'loop over columns to search in
'no need for On Error Resume Next - test the return value from Match instead
RecordRow = Application.Match(vSearch, lo.ListColumns(col).DataBodyRange, 0)
If Not IsError(RecordRow) Then Exit For 'got a hit - stop searching
Next col
ErrorLabel.Visible = IsError(RecordRow) 'hide/show error label
If Not IsError(RecordRow) Then LoadRecord lo.ListRows(RecordRow).Range
End Sub
EDIT: after clarification - different search methods depending on length of input
Private Sub CommandButton1_Click()
Dim RecordRow As Variant '<<< not Long, or throws an error when no match
Dim vSearch, col, lo As ListObject
Set lo = ThisWorkbook.Worksheets("Data").ListObjects("JobSheet") 'adjust sheet name
vSearch = TextBoxSearch.Value
If Not IsNumeric(vSearch) Then
MsgBox "Search value must be numeric!"
End If
'decide how to search based on length of search input
Select Case Len(vSearch)
Case 4
'call custom function instead of Match
RecordRow = EndsWithMatch(vSearch, lo.ListColumns("ON1Call Ticket #").DataBodyRange)
Case 6
'cast search value to Long before using Match
RecordRow = Application.Match(CLng(vSearch), lo.ListColumns("W/O").DataBodyRange, 0)
Case Else
MsgBox "Search value must either 4 or 6 digits!"
End Select
ErrorLabel.Visible = IsError(RecordRow) 'hide/show error label
If Not IsError(RecordRow) Then LoadRecord lo.ListRows(RecordRow).Range
End Sub
'search a single-column range of data for an "ends with" match to `vSearch`
Function EndsWithMatch(vSearch, rngSrch As Range)
Dim i As Long, arr
arr = rngSrch.Value
For i = 1 To UBound(arr, 1)
If arr(i, 1) Like "*" & vSearch Then
EndsWithMatch = i
Exit Function 'done searching
End If
Next i
EndsWithMatch = CVErr(xlErrNA) 'no match: return error value as in Match()
End Function
Common to both answers (edit - added some suggestions for saving the edited record):
Dim editedRow as Range 'holds a reference to the row loaded for editing
'Better as a stand-alone method which you can call from other places...
Sub LoadRecord(sourceRow As Range)
With sourceRow
TextBoxNameAddress.Value = .Cells(4).Value & " - " & _
.Cells(3).Value & " - " & .Cells(1).Value
TextBoxHold.Value = .Cells(6).Value
'etc for other fields
End With
Set editedRow = sourceRow 'set a global for the row being edited
'also enable the "Save" button...
End Sub
Sub SaveRecord()
If Not editedRow Is Nothing Then
With editedRow
.Cells(6).Value = TextBoxHold.Value
'etc for the other fields
End With
Else
MsgBox "No row is being edited!"
End If
End Sub
It's easier/safer to test the return value from Match() than to turn off errors.
The majority of my code is working correctly however, when I move onto validation form the userform to excel it isn't working correctly. I am using a form that allows the user to enter in a job number in column AA and Quantity in Column AC. I am keeping a list of jobs in column A. When the user uses the button it will auto fill columns AA thru AD I am looking for after this is done it will check to see if the job number exists in column A and if it does then in the same row in Column D it would add the quantity that was just entered. In the background I have a piece of code that will auto calculate and increase in column D
Private Sub CommandButton1_Click()
whichSheet = PartNoTxtBox.Value
If whichSheet = "" Then
MsgBox "You didn't specify a Part Number"
Exit Sub
End If
Worksheets(whichSheet).Activate
If Me.PartNoTxtBox = "" Then GoTo MoreInfo
If Me.AddJobNoTxtBox = "" Then GoTo MoreInfo
If Me.AddShipperNoTxtBox = "" Then GoTo MoreInfo
If Me.AddQtyTxtBox = "" Then GoTo MoreInfo
If Me.AddDate = "" Then GoTo MoreInfo
''LastRow
eRow = Cells(Rows.Count, "AA").End(xlUp).Offset(1, 27).Row
Cells(eRow, 27) = AddJobNoTxtBox.Text
Cells(eRow, 28) = AddShipperNoTxtBox.Text
Cells(eRow, 29) = AddQtyTxtBox.Text
Cells(eRow, 30) = AddDate.Text
If AddJobNoTxtBox.Value = Cells(eRow, 1) Then
Cells(eRow, 4) = AddQtyTxtBox.Text
End If
Unload UserForm1
Exit Sub
MoreInfo:
MsgBox "More information required."
End Sub
The issue is located at the If AddJobNoTxtBox.Value=Cells...
any direction would be helpful.
I will admit to being a terrible at code, and have always struggled with Macros... forgive my ignorance.
What I am working on building is a part number index that will create a new sequential number within a numerical series after a macro-button is pressed.
I'd like each button to scan between a range [i.e. 11-0000 (MIN) and 11-9999 (MAX)] and select the max value cell that exists. At that selection point insert an entire new row below with the next + 1 sequential number in the "B" column.
I have my button creating the table row as I would like, however I need help in defining the ".select(=Max(B:B))" and as I understand Max will also limit the # of line items it queries?
I have also been playing with .Range("B" & Rows.CountLarge) with little to no success.
Ideally the 11-**** button [as seen in the screen cap] should insert a sequential number below the highlighted row.
Maybe I'm way over my head, but any guidance even in approach or fundamental structure of the code would help be greatly appreciated!
Private Sub CommandButton1_Click()
Sheets("ENGINEERING-PART NUMBERS").Range("B" & Rows.CountLarge).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Value = "=ActiveCell + 1"
End Sub
Screen Cap of Spread Sheet
Perhaps there is a simpler solution that I've overlooked, but the below will work.
Insert a module into your workbook and add this code:
Public Sub AddNextPartNumber(ByVal FirstCellInColumn As Range, Optional ByVal PartMask As Variant = "")
Dim Temp As Variant, x As Long, MaxValueFound(1 To 2) As Variant
'Some error checking
If PartMask = "" Then
MsgBox "No part mask supplied", vbCritical
Exit Sub
ElseIf Not PartMask Like "*[#]" Then
MsgBox "Invalid part mask supplied; must end in ""#"".", vbCritical
Exit Sub
ElseIf PartMask Like "*[#]*[!#]*[#]" Then
MsgBox "Invalid part mask supplied; ""#"" must be continuous only.", vbCritical
Exit Sub
End If
'Get the column of data into an array
With FirstCellInColumn.Parent
Temp = .Range(FirstCellInColumn, .Cells(.Rows.Count, FirstCellInColumn.Column).End(xlUp))
End With
'Search through the array and find the largest matching value
For x = 1 To UBound(Temp, 1)
If Temp(x, 1) Like PartMask Then
If MaxValueFound(1) < Temp(x, 1) Then
MaxValueFound(1) = Temp(x, 1)
MaxValueFound(2) = x
End If
End If
Next x
'Output new part number
If MaxValueFound(2) = 0 Then
'This part mask doesn't exist, enter one with 0's at the end of the list
With FirstCellInColumn.Offset(x - 1, 0)
.Value = Replace(PartMask, "#", 0)
.Select
End With
Else
'Get the length of the number to output
Dim NumberMask As String, NumFormatLength As Long
NumFormatLength = Len(PartMask) - Len(Replace(PartMask, "#", ""))
NumberMask = String(NumFormatLength, "#")
'Determine the new part number
MaxValueFound(1) = Replace(MaxValueFound(1), Replace(PartMask, NumberMask, ""), "")
MaxValueFound(1) = Replace(PartMask, NumberMask, "") & Format((MaxValueFound(1) * 1) + 1, String(NumFormatLength, "0"))
'Insert row, add new part number and select new cell
FirstCellInColumn.Offset(MaxValueFound(2), 0).EntireRow.Insert
With FirstCellInColumn.Offset(MaxValueFound(2), 0)
.Value = MaxValueFound(1)
.Select
End With
End If
End Sub
Then, for each button, you write the code like this:
Private Sub CommandButton1_Click()
'this is the code for the [ADD 11-****] button
AddNextPartNumber Me.Range("B16"), "11-####"
End Sub
Private Sub CommandButton2_Click()
'this is the code for the [ADD 22-****] button
AddNextPartNumber Me.Range("B16"), "22-####"
End Sub
This has been written assuming that inserting a new row onto your sheet won't affect other data and that adding new data to the bottom of the table without inserting a row also won't affect other data.
Assuming you're working with a table, by default it should auto-resize to include new data added to the last row.
Good luck learning the ropes. Hopefully my comments help you understand how what I wrote works.
I work on sheet 1 and sheet 2 and in both sheets there are shapes that contain code. The Shape ID in sheet 1 is "RUN 1" and in sheet 2 is "EQ-1". I already have a code that can identify the shape ID I've clicked on sheet1 / sheet2. But the code is debug with the explanation "the item with the specified name wasn't found". Thanks. Please help :)
This code must be located in the sheet 2
sub x ()
'the first trial
If Sheet1.Shapes(Application.Caller).Name = "RUN 1" Then Sheet2.Cells(1, 2) = "x"
If activesheet.Shapes(Application.Caller).Name = "EQ-1" Then Sheet2.Cells(1, 2) = "x"
'the second trial
If Sheet1.Shapes(Application.Caller).Name = "RUN 1" Or _
activesheet.Shapes(Application.Caller).Name = "EQ-1" Then Sheet2.Cells(1, 2) = "x"
end sub
Try...
Sub x()
If Application.Caller = "RUN 1" Or Application.Caller = "EQ-1" Then
Sheet2.Cells(1, 2) = "x"
End If
End Sub
Hope this helps!
Why does the following code not delete irrelevant rows in my spreadsheet?
Sub Macro1Format()
'
' Macro1Format Macro
'
Dim i As Integer
i = 0
Do While (Range("A1").Value <> "Project ID") And (i < 100)
Range("1:1").Delete
i = i + 1
Loop
End Sub
I'll take a stab that you would like something like:
Sub Macro1Format()
Dim i As Integer
i = 99
For i = 99 To 1 Step -1
If Range("A" & i).Value <> "Project ID" Then
Range(i & ":" & i).Delete
End If
Next
End Sub
You seem to have confused 1 with i but also when deleting rows it may be best to start from the bottom up since the row count changes as a consequence of any row deletion. There were also some syntax problems.