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***
Related
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.
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.
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.
Multi Criteria Index/Match VBA across two sheets in the same workbook
So, basically, I have 2 sheets in a same workbook
Sheet 1 looks like this:
Sheet 2 looks like this:
I want to match the Comments section based on PO/SO AND Activity using VBA instead of formula.
Below is the code I tried to write, but it’s not working…
Dim ID As String, Activity As String
For r = 2 To ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count
ID = ThisWorkbook.Worksheets("Sheet1").Cells(r, 1).Value
Activity = ThisWorkbook.Worksheets("Sheet1").Cells(r, 2).Value
For s = 2 To ThisWorkbook.Worksheets("Sheet2").UsedRange.Rows.Count
If ThisWorkbook.Worksheets("Sheet2").Cells(s, 1).Value = ID And ThisWorkbook.Worksheets("Sheet2").Cells(s, 2).Value = Activity Then
ThisWorkbook.Worksheets("Sheet2").Cells(s, 3).Value = ThisWorkbook.Worksheets("Sheet1").Cells(s, 3).Value
End If
Next s
Next r
If I try to run the code, I won't get any error warnings, but nothing else would happen neither...no error message, no any reaction. I double checked all names, column numbers, and everything
I had no problem with your code except you need to Change this line...
ThisWorkbook.Worksheets("Sheet2").Cells(s, 3).Value = ThisWorkbook.Worksheets("Sheet1").Cells(s, 3).Value
To
ThisWorkbook.Worksheets("Sheet2").Cells(s, 3).Value = ThisWorkbook.Worksheets("Sheet1").Cells(r, 3).Value
Hi Emma Assuming your sheet 1 and your sheet 2 have the same column lineup.
Sub findMatch()
Dim ID As String
Dim Activity As String
For r = 2 To ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count
ID = ThisWorkbook.Worksheets("Sheet1").Cells(r, 1).Value
Activity = ThisWorkbook.Worksheets("Sheet1").Cells(r, 2).Value
For s = 2 To ThisWorkbook.Worksheets("Sheet2").UsedRange.Rows.Count
If ThisWorkbook.Worksheets("Sheet2").Cells(s, 1).Value = ID And ThisWorkbook.Worksheets("Sheet2").Cells(s, 2).Value = Activity Then
ThisWorkbook.Worksheets("Sheet2").Cells(s, 4).Value = ThisWorkbook.Worksheets("Sheet1").Cells(s, 3).Value
End If
Next s
Next r
End Sub
This is the code you presented above and it worked just fine for me. I made a minor change to test for myself just on this line.
ThisWorkbook.Worksheets("Sheet2").Cells(s, 4).Value = ThisWorkbook.Worksheets("Sheet1").Cells(s, 3).Value
here is my workbook. sheet 1 and sheet 2. I will caution, however, that looking for a match in this order could be troublesome. I would use much rather use a find function and loop sheet 2.
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.