On a Form I am using a ComboBox to search a text range and return that row value. The ScrollBox value is then set to the row value. My minimum row value is 5 and the max value is done by a row.count which happens to be 28. When I run the code the ScrollBar works fine until my value gets over 23, the scrollbar.value resets to 7 and starts all over again. Using the combobox to set the row value has the same problem as well and I am unable to search the whole text range.
Here is my code:
Private Sub ScrollBar1_Change()
g = ScrollBar1.Value
StrtComboBox.Value = Sheets("Main").Cells(g, 6).Value
Plyr1Lbl.Caption = Sheets("Main").Cells(g, 7).Value
Plyr2Lbl.Caption = Sheets("Main").Cells(g, 8).Value
Plyr3Lbl.Caption = Sheets("Main").Cells(g, 9).Value
Plyr4Lbl.Caption = Sheets("Main").Cells(g, 10).Value
TextBox9.Value = ScrollBar1.Value
TextBox10.Value = ScrollBar1.Max
End Sub
Private Sub StrtComboBox_Change()
Sheets("Main").Activate
LastHoleRow = Sheets("Main").Cells(Rows.Count, 6).End(xlUp).Row
Names.Add Name:="Holes", RefersTo:=Range("F5:F" & LastHoleRow)
Dim BoxValue As Range
With Range("Holes")
Set BoxValue = .Find(StrtComboBox.Value)
If BoxValue Is Nothing Then
Else
ScrollBar1.Value = BoxValue.Row
End If
End With
End Sub
You are searching for 8A and expecting to find it in F24, however it can be found earlier in F7 which has value 18A (since 8A can be found in the string 18A).
The fix should be simple. The .Find method has a .LookAt parameter which determines whether a complete match must be made. So just change
Set BoxValue = .Find(StrtComboBox.Value)
to this
Set BoxValue = .Find(What:=StrtComboBox.Value, LookAt:=xlWhole)
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.
I need to be able to create a loop (probably For Each) for the Column N and paste the sum of the values into cells C49, C50, C51 based on certain conditions. If Column G has a "No" value, then the value from Column N needs to only be pasted into C50, if it is a "Yes" value, then the value needs to go into C49. As you can see, C51 is a combination of both "Yes" and "No" values so I was able to accomplish that task. However, as you can see in C50, I am unable to get a sum of all "No" values as they are inputted, only the most recent cell value is taken. I need to be able to get the Sum of all "No" and "Yes" values and put them into C50 and C49 respectively. Additionally, I need to also be able to paste the timeline of this happening in D49:N49, D50:N50, D51:N51. By timeline I mean that based off of N3 being a "No" with a $1.00 value, that will go into D50 and the next "No" value is a $2.00 so that would go into E50 but also add onto the $1.00 value prior, so E50 would actually be a $3.00 amount. The first image I have attached is a visual of what I have so far, the second image is what the desired output is, as well as my code below. All help is appreciated, thank you.
*Edit-Added Jorge's code, all code being used is shown in the 3rd image, lmk if that is correct or not because I am not getting the desired result. For whatever reason, any "No" value is being inserted into B50 and C51 but not into B51 where it is supposed to go. Also, a running total is not being maintained. I only kept the declared variables (whatever is shown in the 3rd image) so maybe I messed up Jorge's anticipated result by not maintaining some of my code ...?
Private Sub test()
Dim wb_nyu_rap_calc As Workbook
Dim ws_loans As Worksheet
Dim rng_adj_monthly_payment As Range
Dim eligible_loan_payment As Long
Dim non_law_loan_payment As Long
Dim all_loan_payment As Long
Dim rng_law_debt As Range
Set wb_nyu_rap_calc = Workbooks("testnyu.xlsm")
Set ws_loans = wb_nyu_rap_calc.Sheets("Loans")
Set adj_monthly_payment = ws_loans.Range("N3:N22")
Set rng_law_debt = ws_loans.Range("G3:G22")
'All Loan Payment
ws_loans.Range("C51") = WorksheetFunction.Sum(adj_monthly_payment)
'Non Law Loan Payment
For Each cell In rng_law_debt
If cell.Value = "No" And cell.Offset(0, 7).Value <> "" Then
ws_loans.Range("C50") = WorksheetFunction.Sum(cell.Offset(0, 7).Value)
'ws_loans.Range("C50") = WorksheetFunction.Sum(cell)
End If
Next
'using this to test that the code is properly inputting
MsgBox ("DONE")
End Sub
*********************************************************
Private Sub worksheet_change(ByVal Target As Range)
If Not Intersect(Target, Range("N3:N22")) Is Nothing Then
Call test
End If
End Sub
You'll need to use variables to store the values of each sum.
I would change this:
'Non Law Loan Payment
For Each cell In rng_law_debt
If cell.Value = "No" And cell.Offset(0, 7).Value <> "" Then
ws_loans.Range("C50") = WorksheetFunction.Sum(cell.Offset(0, 7).Value)
'ws_loans.Range("C50") = WorksheetFunction.Sum(cell)
End If
Next
to this:
'Non Law Loan Payment
dim sumNo as double, sumYes as double
For Each cell In rng_law_debt
If cell.Offset(0, 7).Value <> "" Then
If cell.Value = "No" Then
sumNo = sumNo + cell.Offset(0, 7).Value
else if cell.value = "Yes" then
sumYes = sumYes + cell.Offset(0, 7).Value
End If
End If
Next
ws_loans.Range("C49").value = sumYes
ws_loans.Range("C50").value = sumNo
The next part is a bit trickier, because you need to calculate the last used column on those 3 rows. Here's a function I use to get this:
Public Function lastCol(ByVal wSheet As Worksheet, x As Integer) As Long
lastCol = wSheet.Cells(x, wSheet.Columns.Count).End(xlToLeft).Column
End Function
Add it to your code, and then we can call it from inside the Ifs in the for loop to write every value to it's corresponding row (after writing a value first on the sum column, or we will miss the first value every time we run this), and also to the "All Loan Payment" row disregarding if cell is "Yes" or "No", like this:
(I added a cleanup of the sum cells, in order for this to work properly every time)
'Non, Eligible and All Law Loan Payment
dim sumNo as double, sumYes as double
'Cleanup
ws_loans.Range("C49:AA51").ClearContents
ws_loans.Range("C51") = WorksheetFunction.Sum(adj_monthly_payment)
For Each cell In rng_law_debt
If cell.Offset(0, 7).Value <> "" then
If cell.Value = "No" Then
sumNo = sumNo + cell.Offset(0, 7).Value
ws_loans.Range("C49").value = sumNo
ws_loans.cells(50,lastcol(ws_loans,50)+1).value = cell.Offset(0, 7).Value
else if cell.value = "Yes" then
sumYes = sumYes + cell.Offset(0, 7).Value
ws_loans.Range("C50").value = sumYes
ws_loans.cells(49,lastcol(ws_loans,49)+1).value = cell.Offset(0, 7).Value
End If
ws_loans.cells(51,lastcol(ws_loans,51)+1).value = cell.Offset(0, 7).Value
End If
Next
Please let me know if this works as you require, or if you have any questions.
Can anyone help with the following.
Working in excel. Have created a table that is filled using a form. Cells in range a:1 to J:31 (Table1).
The form auto completes the table, however when an entry is deleted (anywhere) in the table I need the form to fill those empty spcaes. At the moment once the table is complete even when information I deleted no new entries can be entered using the form. In addition i need the form to fill the first empty cell.
Lets say that the only space available that I have is row 12, I want to be able to put the information there using my userform.
The table is an admissions to a hospital sheet including name, number, bedroom, date of arrival, doctor and other such info, filled across. The main point is that I don't want to create another row to enter data, the data should be just in the range of the table a:1 to J:31
I have this code in vba
Private Sub CommandButtonSave_Click()
Dim fill As Lonng
Sheets("Ward Planner").Activate
fill = WorksheetFunction.CountA(Range("Table1")) + 1
Cells(fill, 1).Value = ComboBoxBed
Cells(fill, 2).Value = TextBoxName.Text
Cells(fill, 3).Value = ComboBoxConsultant
Cells(fill, 4).Value = TextBoxPcn.Text
Cells(fill, 5).Value = TextBoxDoa.Text
Cells(fill, 6).Value = ComboBoxGender
Cells(fill, 7).Value = ComboBoxStatus
Cells(fill, 8).Value = ComboBoxDiet
Cells(fill, 9).Value = TextBoxComments.Text
End Sub
It looks like you need a test to see whether a blank row is available or not - then some code to find that row (based on column A) before pasting your data to it. The following code is untested but should work given the description in your question. Please try it & let me know how it goes.
Private Sub CommandButtonSave_Click()
Dim c As Range, fill As Long, ws As Worksheet
Set ws = Sheets("Ward Planner")
If Application.WorksheetFunction.CountBlank(ws.Range("A1:A31")) = 0 Then
MsgBox "No available rows"
Exit Sub
End If
For Each c In ws.Range("A1:A31")
If c.Value = "" Then
fill = c.Row
'ws.Cells(fill, 1).Value...etc" code goes here
'copy your current code - but please note the "ws." prefix
Exit Sub
End If
Next c
End Sub
I found that this code works too, just in case someone would like to try both.
Dim fill As Long
Sheets("Ward_Planner").Activate
On Error Resume Next
fill = Range("A2:A29").SpecialCells(xlBlanks)(1).Row
On Error GoTo 0
If fill = 0 Then
MsgBox "all beds are filled"
Exit Sub
End If
Cells(fill, 1).Value = ComboBoxBed.Value
Cells(fill, 2).Value = TextBoxName.Value***
Hey I have been writing some code to add a part ID to a spreadsheet off of a user form in Excel VBA. I have been reading through different documentation and can not figure out why no matter what type of method of inserting a row I try it inserts a row with a repeating value instead of a blank one. If anyone knows how to specify blank, other than writing the whole row to blank and then writing my numbers I want after, that would be appreciated.
I have tried both the following lines to add a row
Cells (x+1 ,column).EntireRow.Insert Shift:= xlDown
ws1.Rows(x+1).Insert Shift:=xlDown
This is the function it is used in:
Public Sub Add(IDRange As Range)
SearchCell = Cells(x, IDRange.Column)
Cells(x, IDRange.Column).Select
Do
If SearchCell = PartID Then
MsgBox " this Company Already uses this part"
Exit Sub
ElseIf x <> StopRow Then
x = x + 1
SearchCell = Cells(x, IDRange.Column)
End If
Loop While x <> StopRow And SearchCell <> PartID
Cells(x + 1, IDRange.Column).EntireRow.Insert Shift:=xlDown
Cells(x, IDRange.Column).Value = PartID
MsgBox PartID & " has been added to Adress " & Cells(x, IDRange.Column).Address
Cells(x, IDRange.Column).Select
End Sub
Bellow is the function that calls the Add Function and where I belive it may be getting the company name from
Private Sub AddPart_Click()
AddPartCounter = 0
Company = UserForm1.CompanyBox.Value
PartID = UserForm1.PartBox.Value
If Company = "" Then
MsgBox " Please put in the company you would like the part to go under"
ElseIf PartID = "" Then
MsgBox " Please put in the Part you would like entered"
ElseIf UserForm1.Studs.Value = False And UserForm1.Spreaders.Value = False And UserForm1.Blocks.Value = False And UserForm1.Imma.Value = False Then
MsgBox "Please select the type of part you are trying to add"
Else
Dim CurrentCell
Set CurrentCell = Cells.Find(What:=Company, LookAt:=xlWhole)
If CurrentCell Is Nothing Then
MsgBox " Company Not Found "
Exit Sub
End If
x = CurrentCell.Row
Do
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop While CurrentCell.Offset(1, 0) = "" And Not CurrentCell Is Nothing And CurrentCell.Offset(1, 0).Row <> thisvar.Row + 1
StopRow = CurrentCell.Row
'If they are trying to add a nut
If UserForm1.Imma.Value = True Then
Call Add(Nut_ID_Rng)
'IF they are trying to add a stud
ElseIf UserForm1.Studs.Value = True Then
Call Add(Stud_ID_Rng)
'If they are trying to add a block
ElseIf UserForm1.Blocks.Value = True Then
Call Add(Block_ID_Rng)
'If they are trying to add a spreader
ElseIf UserForm1.Spreaders.Value = True Then
Call Add(Spreader_ID_Rng)
End If
End If
AddPartCounter = 1
End Sub
I know that the repeating pattern is coming from the insert line through debugging but I can not figure out why I have tried changing variables to numbers and it still did the same thing. This what it looks like with the repeating values.
enter image description here
The problem is that you most likely have a value still stored in your clipboard when you execute the Macro. To fix that, simply add this line of dode before running the insert line:
Applcation.CutCopyMode = False
That will clear your clipboard and allow the inserted rows to be blank.
I'm looking at my CSV sheet for a check (from my checking account) to compare with another sheet called checking. I want to match checks up. I'm balancing the bank statement. "A" is the value but I also want to store the values to the left of this (the description.)
I used a double nested "FOR" statement to accomplish this, with the first "FOR" shown here. In the CSV list, the first one is:
Description= Citgo
A= 1.53
next is:
Description = MCD
A = 2.42
When I run the below I get
a= 1.53
Description: Citgo
Then, as the FOR loops I get:
A=2.42
Description = Citgo (it should be MCD - it's not incrementing.)
How do I correct this?
Sheets("CSV").Select
Set ShtCSV = ActiveSheet
Range("a499").End(xlUp).Select
Set CSVBottomLeft_A = Selection
Range("d150").End(xlUp).Select
Set CSVBottomRight_D = Selection
Range("d2", CSVBottomRight_D).Select
Set CSVSelection_Area = Selection
'Range("A1").Select
'''''''''''''''''''''''''''
Sheets("matrix").Select
Set ShtMx = ActiveSheet
'''''''''''''''''''''''''''
Sheets("checking").Select
Set ShtChecking = ActiveSheet
Range("e499").End(xlUp).Select
BottomChecks_E = Selection.Address
Set CheckArea = Range("E5", BottomChecks_E)
Range("d499").End(xlUp).Select
BottomDeposites_D = Selection.Address
Set DepositeArea = Range("d5", BottomDeposites_D)
Range("c499").End(xlUp).Select
ML 1
Set BottomLeft_B = Selection
Range("g499").End(xlUp).Select
Set BottomRight_G = Selection
Range("B5", BottomRight_G).Select
Set CheckSelection_Area = Selection
ShtCSV.Select
For Each A In CSVSelection_Area 'For-1
ShtCSV.Select
CSV = A
CSVDescription = ActiveCell.Offset(0, -1).value 'left 1
CSVChkNumber = ActiveCell.Offset(0, -2).value
CSVDate = ActiveCell.Offset(0, -3).value
MsgBox A
MsgBox CSVDescription
next
Using ActiveCell refers to the ActiveWorkSheet whereas you want to refer to your A Range. Try it like this instead
CSVDescription = A.Offset(0, -1).value 'left 1
CSVChkNumber = A.Offset(0, -2).value
CSVDate = A.Offset(0, -3).value