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.
Related
I would like to create a userform in which the user may select some data entries that i've specified in order to open another userform that contains all the info in the said row so they will be able to edit the entries.
i've already initialized my userform so the data can be added to the comboboxes. the problem that i'm currently facing is that with the code i'm using i'm only allowed to lookup a row using one comboboxes out of 4 . tho i used the same code for the other 3 it refuses to work correctly.
The ID_Edit is the name of the first combobox and dyn mat is simply = OFFSET(Data!$A$6;0;0;Help!$B$2;1) it allows me to go through the column in which i have the IDs
in this case it is working correctly but once i add other variables similar to the TargetRow that contains similar entries but with diffrent refrences it won't work. Could you please suggest some way to solve this
Private Sub CommandButtonSearch_Click()
Dim TargetRow As Long
TargetRow = Application.WorksheetFunction.Match(Val(ID_Edit), Sheets("Data").Range("dyn_mat"), 0)
'i still need to add the other 3
Sheets("Help").Range("B4").Value = TargetRow
Unload UF_EDIT
'retreive all the data from the specific row
UF_DATA.TextBoxID = Sheets("Data").Range("StartingData").Offset(TargetRow, 0).Value
UF_DATA.TextBoxName = Sheets("Data").Range("StartingData").Offset(TargetRow, 1).Value
UF_DATA.ComboBoxDep = Sheets("Data").Range("StartingData").Offset(TargetRow, 2).Value
UF_DATA.ComboBoxProject = Sheets("Data").Range("StartingData").Offset(TargetRow, 3).Value
UF_DATA.ComboBoxFamily = Sheets("Data").Range("StartingData").Offset(TargetRow, 4).Value
UF_DATA.TxtTask = Sheets("Data").Range("StartingData").Offset(TargetRow, 5).Value
UF_DATA.TextBoxStart = Sheets("Data").Range("StartingData").Offset(TargetRow, 6).Value
UF_DATA.TextBoxDuration = Sheets("Data").Range("StartingData").Offset(TargetRow, 7).Value
UF_DATA.TxtComp = Sheets("Data").Range("StartingData").Offset(TargetRow, 9).Value
UF_DATA.Show
End Sub
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.
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***
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
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.