EXCEL VBA Dynamic Data Entry - excel

RED colour box in Range("D:D") is the value refer from the Me.ComboBox1.Value
Yellow and green colour are the data from Me.TextBox1 and Me.TextBox2 respectively. In Me, value in Me.TextBox1 and Me.TextBox2 will be insert into this sheet according to the value selected in the Me.ComboBox1.
Therefore, in this case, I wanted the yellow and green colour to be entered accordingly to the red selected by user.
Another extra thing is that I put a .OffSet(1,0).EntireRow.Insert for the last row of yellow and green data

This should do it:
nextrow = Sheets("DB Cust").Range("C" & Sheets("DB Cust").Rows.Count).End(xlUp).Row + 1
UPDATE Following your edit, I think something similar to this could be what you need. Please note that this depends on there always being a value in column E for each block of data in order for it to work:
Dim lngNewRow As Long
Dim strLookupValue As String
strLookupValue = "A" ' or B/C/D etc.
lngNewRow = Sheets("DB Cust").Range("D:D").Find(strLookupValue).Offset(, 1).End(xlDown).Row + 1
Sheets("DB Cust").Rows(lngNewRow).Insert
Sheets("DB Cust").Cells(lngNewRow, "E").Value = "Data for column E"
Sheets("DB Cust").Cells(lngNewRow, "F").Value = "Data for column F"
With regards to your point 4, if "D" is the last value in the list then why do you need to insert additional blank rows, presumably all rows beneath it are blank anyway?

I'm not sure but the way you are calling your range seems strange to me. Try a different way of defining your count range.
Change this:
nextrow = WorksheetFunction.CountA(Sheets("DB Cust").Range("C:C")) + 2
To this:
Dim myWB as Workbook, DBcust as Worksheet
Set myWB = Excel.ActiveWorkbook
Set DBcust = myWB.Worksheets("DB Cust")
nextrow = Excel.WorksheetFunction.CountA(DBcust.Range(DBcust.Cells(1,3),DBcust.Cells(DBcust.UsedRange.Rows.Count,3)) + 2
I assigned the book and sheet to a variable for more reliability, but you can explicitly state them again if you wanted to. This code assumes the workbook is the currently active workbook, if not you will have to set the variable using the workbook name.
Also, it doesn't look like you need the "rfound" portion of the offset function within the "With" block . . . that is what the "With" is there for. It's just a little thing but meaningless code like that will only cause you extra headache so my advice would be to take it out.
I haven't loaded this into the VBA IDE so please double check for spelling errors. Thanks!
UPDATE:
After reading your comment, I took a closer look at your code and what it is you're trying to do. It looks like you are trying to place the value of textbox1 (whatever that may be...it would help if you explained this part a little) into a cell offset from the location of a search result defined by the user in combobox1. The nextrow variable is inside the row offset parameter, but the location is already where you want it to be. Try changing this:
With rfound
rfound.Offset(nextrow, 1).Value = TextBox1.Value
rfound.Offset(nextrow, 2).Value = TextBox1.Value
rfound.Offset(nextrow, 3).Value = TextBox1.Value
rfound.Offset(nextrow, 4).Value = TextBox1.Value
rfound.Offset(nextrow, 5).Value = TextBox1.Value
rfound.Offset(nextrow, 6).Value = TextBox1.Value
rfound.Offset(nextrow, 7).Value = TextBox1.Value
rfound.Offset(nextrow, 8).Value = TextBox1.Value
MsgBox ("Data entry success")
End With
To this:
With rfound
.Offset(0, 1).Value = TextBox1.Value
.Offset(0, 2).Value = TextBox1.Value
.Offset(0, 3).Value = TextBox1.Value
.Offset(0, 4).Value = TextBox1.Value
.Offset(0, 5).Value = TextBox1.Value
.Offset(0, 6).Value = TextBox1.Value
.Offset(0, 7).Value = TextBox1.Value
.Offset(0, 8).Value = TextBox1.Value
MsgBox ("Data entry success")
End With
You may notice I also removed the redundant "rfound" as per my previous advice. See if this works and if so you may want to remove the newrow variable all together.
Good luck and let us know how it goes.

Related

runtime 1004 Application.WorksheetFunction.Match Unable to get the Match Property of the Work

here I tried to create some userforms to update my data table. I have this data table (CTR Summary information) to give a basic information because I have a lot of columns to fill and it will be kind of messy to put it all informations together in one form. So I split it to some section of form depend on the section need to be update.
If I click to update commandbutton it will redirect to Update form and it pull the data information section I need from the list box. Like the picture below
After I change my value from text box and click update, it gave me error Application.WorksheetFunction.Match Unable to get the Match Property of the Work.
here's my code
Private Sub UPDATE_Click()
If MsgBox(" Check the Data Again ", vbYesNo, "Proceed to Subcontractor Form Information if Any") = vbYes Then
' write the data to the worksheet from controls
Call WriteDataToTheSheet
' empty the textboxes
Call EmptyTextBoxes
Else
' empty the textboxes
Call EmptyTextBoxes
End If
End Sub
'UPDATE CODE
Private Sub WriteDataToTheSheet()
With Sheet2
Dim selectedRow As Long
LRow = .Range("A" & .Rows.Count).End(xlUp).row
selectedRow = Application.WorksheetFunction.Match(WONUMBER.Value, Sheet2.Range("I2:I" & LRow), 0)
.Cells(selectedRow, 1).Value = Now
.Cells(selectedRow, 2).Value = NAMACLIENT.Value
.Cells(selectedRow, 3).Value = BLANKETNUMBER.Value
.Cells(selectedRow, 4).Value = CTRNUMBER.Value
.Cells(selectedRow, 5).Value = PICBIRU.Value
.Cells(selectedRow, 6).Value = PICCLIENT.Value
.Cells(selectedRow, 7).Value = PROJECTSTATUS.Value
.Cells(selectedRow, 8).Value = PROJECTTITLE.Value
.Cells(selectedRow, 9).Value = WONUMBER.Value
.Cells(selectedRow, 10).Value = WODIR.Value
.Cells(selectedRow, 11).Value = WOSTARTDATE.Value
.Cells(selectedRow, 12).Value = WOENDDATE.Value
.Cells(selectedRow, 13).Value = REMARKS.Value
.Cells(selectedRow, 14).Value = WAPU.Value
.Cells(selectedRow, 17).Value = ENGVALUE.Value
.Cells(selectedRow, 18).Value = REIMBURSABLE.Value
End With
End Sub
Can you tell me what I am doing wrong? I just started a couple weeks ago in vba and I make this code from different kind of youtube references. I just really stuck in this one. I'm really appreciate your help.
EDIT:
sorry to gave you minimal information
this is my excel data image
This is my debugging code image
On the worksheet are the WONUMBERS numeric? If they are you would need to convert the text WONUMBER from the textbox in the userform to numeric, you can do that using Val.
selectedRow = Application.Match(Val(WONUMBER.Value), Sheet2.Range("I2:I" & LRow), 0)
Alternatively, you could add a, hidden, textbox on the update form, populate it with the row the selected in the previous form and use that when updating.
Alternatively, you can put your search value into a cell on some worksheet and use that cell in the match statement. That worksheet can be hidden.

Use Event Trigger to paste values from one range to a cell and another range and use the sum function to keep a running total [VBA]

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.

VBA Next available row

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***

How to fix "Run-time error '380': Could not set the RowSource property."

I have used the exact same code below for different sheets and it works correctly, but when I edited it for a new set of sheets in the same workbook the Run Time error comes up.
Private Sub cmdSearchKitDesc_Click()
Dim RowNum As Long
Dim SearchRow As Long
RowNum = 3
SearchRow = 3
Worksheets("Kit_database").Activate
Do Until Cells(RowNum, 1).Value = ""
If InStr(1, Cells(RowNum, 3).Value, txtKitKeyword.Value, vbTextCompare) > 0 Then
Worksheets("Kit_search").Cells(SearchRow, 2).Value = Cells(RowNum, 2).Value
Worksheets("Kit_search").Cells(SearchRow, 3).Value = Cells(RowNum, 3).Value
Worksheets("Kit_search").Cells(SearchRow, 4).Value = Cells(RowNum, 4).Value
Worksheets("Kit_search").Cells(SearchRow, 5).Value = Cells(RowNum, 6).Value
Worksheets("Kit_search").Cells(SearchRow, 6).Value = Cells(RowNum, 8).Value
Worksheets("Kit_search").Cells(SearchRow, 7).Value = Cells(RowNum, 9).Value
SearchRow = SearchRow + 1
End If
RowNum = RowNum + 1
Loop
If SearchRow = 2 Then
MsgBox "No kits were found that match your criteria."
Exit Sub
End If
lstKitResult.RowSource = "KitKit"
End Sub
I have changed RowNum to 3 to match the column of the sheet (in this case I would like to search the description of a kit) I would like to search and respectively in the string. I have carefully checked that the sheets and OFFSET function that it uses are named correctly.
The list box I would like to populate uses,
lstKitResult.RowSource = "KitKit" where "KitKit" uses the following OFFSET formula,
=OFFSET(Kit_search!$B$3,0,0,COUNTA(Kit_search!$C:$C)-1,6)
The "Kit_database" sheet holds all the different types of kits I would search from. The "Kit_search" sheet is a placeholder for all the results found that match the kit description searched. The OFFSET function pulls data "Kit_search" that should be populated with the search results of txtKitKeyword.Value
I have tried different column numbers and sheet names to make sure that things match up but the Run Time error always comes up.
It depends on what "KitKit" is. You would need to set the RowSourceType to correctly interpret the value. If you set it to "Value List" then the list would contain only "KitKit". So I must assume that you are trying to use a Table\Query or Field List. It sounds like you're saying "KitKit" is a named range that points to an offset formula. That would indeed be an error. The result of "KitKit" must contain and answer formatted to match the RowSourceType.
lstKitResult.RowSourceType = "Field List"
From the documentation:
The RowSource property setting depends on the RowSourceType property
setting. For this RowSourceType setting Enter this RowSource setting
Table/Query A table name, query name, or SQL statement.
Value List A list of items with semicolons (;) as separators.
Field List A table name, query name, or SQL statement.
Source: https://learn.microsoft.com/en-us/office/vba/api/access.listbox.rowsource

Filtering through data in a column based on cell value

I need to do the two following things:
1) Delete all rows whereby Current Entity Name equals
Subscription Line of Credit
Other Assets
Net Other Assets
Liabilities
Cash and Cash Equivalents.
2)Append “#UP#” to all of the remaining records of Current Entity Name.
(i.e if Current Entity Name = St Georges Hospital, after running macro, it should end up as #UP#St Georges Hospital).
Current Entity is in column D.
I have the following codes:
Sub Test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim CurrentEntityColumn As Integer
Dim POColumn As Integer
Dim DomColumn As Integer
Dim i As Long
MsgBox ("Select Investment Analysis_Before")
Sourcefile = Application.GetOpenFilename()
Workbooks.Open (Sourcefile)
CurrentEntityColumn = Cells(Rows.Count, "D").End(xlUp).Row
For i = 1 To CurrentEntityColumn
If Cells(i, "D").Value = "Subscription Line of Credit" Or Cells(i, "D").Value = "Other Assets" Then
Cells(i, "D").EntireRow.Delete
End If
Next i
End Sub
However, the code dont seem to be working as it only deletes whatever that I put last in the or argument. In this case it only deletes rows which column D contains "Other Assets". Subscription Line of Credit is not deleted.
I also observed that this error only occurs when I use entirerow.delete. I have tried using changing the font color if cell contains "Subscription Line of Credit" and it works fine.
Can anyone tell me what have I done wrongly and also any ideas to complete task 2? Thanks
what about:
If Cells(i, "D").Value = "Subscription Line of Credit" Then
Cells(i, "D").EntireRow.Delete
ElseIf Cells(i, "D").Value = "Other Assets" Then
Cells(i, "D").EntireRow.Delete
Else
Cells(i, "D").Value = "#UP#" & Cells(i, "D").Value
End If

Resources