I have created an UserForm in vba as follow:
Once a user fills out the form, the record will be saved on "Sheet2". For each Control ID, there should be 3 possible Activities. What I want to do is that after users type in the Control ID and Activity name, the form will be filled with existing data from "Sheet2". Here is what I have come up with by using "Index"/"Match" but it returns with "Type Mismatch" error.
Private Sub Reg3_AfterUpdate()
With Me
.Reg2 = Application.WorksheetFunction.Index(Sheet2.Columns(3), Application.WorksheetFunction.Match(1, (Sheet2.Columns(2) = CLng(Me.Reg1)) * (Sheet2.Columns(4) = CLng(Me.Reg3)), 0))
End With
End Sub
Reg1 is Control ID located in Column 2;
Reg2 is Full Name located in Column 3; and
Reg3 is Activity located in Column 4.
Can someone please help me?
Thomas has a good solution. If you want to use only VBA (no Excel functions), you can also set a search loop like this:
With ws
For row = fisrtRow To lastRow
val = .Cells(row, col)
If val = controlID And val = activity Then
'....
Else
'...
End If
Next row
End With
Something like this could get you on track
'-- lets assume you want value from row 1, column 3
' from "Sheet2"
Dim wb As Workbook
Dim ws As Worksheet
Dim row As Integer, column As Integer
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet2")
row = 1
col = 3
Me.Reg2.Text = ws.Cells(row, col)
here is the best solution for you
write the following code ih the after update event
Private Sub Reg3_AfterUpdate()
SheetS("SHEET2").Range("A1:C4").Select
Selection.AutoFilter
SheetS("SHEET2").Range("$A$1:$C$4").AutoFilter Field:=1, Criteria1:="=Product no", Operator:=xlAnd
SheetS("SHEET2")..Range("$A$1:$C$4").AutoFilter Field:=1, Criteria1:="=Activity", Operator:=xlAnd
'add your code to get the value from range(a2:c2) like the following
FULLNAME.TEXT=SHEETS("sheet2").range("B2)
End Sub
'in this example I assume that the data is stored in range(A1:C4)
'SO AFTER YOU APPLY THE FILTER YOU WILL GET ONE UNIQUE ROW REPRESENTING
'YOUR 'DATA .THEN YOU JUST NEED TO IMPORT THE DATA FROM THE sheet2 CELLs
'and so on
Related
I am writing a script where I want to enable a search in a Database, presenting the results of the search queries in a different worksheet (which I have named Results), so that users do not have access to the whole database at the same time.
In order to do this I want to copy values from the "Database" worksheet into the "Results" worksheet. I have succeeded in selecting the right data from the "Database", in respect to any specific search criteria. I did this with the following code:
With Sheets("Database")
.Range(.Cells(i, 1), .Cells(i, 9)).Copy
End With
Now I want to paste the results into the "Results" spreadsheet and I have done so by writing the following:
Sheets("Results").Range("B600").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
By doing this, I don't quite understand:
if I have strictly defined the paste range as between the first empty row and B600 or;
if I am just defining the beginning of the paste range and, in the case that the search results exceed the 600th row, they will still be pasted after this row.
I ask this because, as the database grows, I will certainly need to guarantee a paste range greater than B600.
I have researched on it but cannot seem to be absolutely sure of what I have done exactly. I must say that I know that the first empty row in the "Results" database will always be 12. In this case, I know that I basically want to paste the search results from the 12th row on. Maybe there is a more straight-forward way to do this.
This is the entire code, for reference:
Private Sub SearchButton_Click()
'This is the search function
'1. declare variables
'2. clear old search results
'3. Find records that match criteria and paste them
Dim country As String
Dim Category As String
Dim Subcategory As String
Dim finalrow As Integer
Dim i As Integer 'row counter
'Erase any entries from the Results sheet
Sheets("Results").Range("B10:J200000").ClearContents
'Deformat any tables in the Results sheet
For Each tbl In Sheets("Results").ListObjects
tbl.Clear
Next
'Define the user-inputed variables
country = Sheets("Results").Range("D5").Value
Category = Sheets("Results").Range("D6").Value
Subcategory = Sheets("Results").Range("D7").Value
finalrow = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row
'If statement for search
'For every variable i, start comparing from row 2 until the final row
For i = 2 To finalrow
'If the country field is left empty
If country = "" Then
Sheets("Results").Range("B10:J200000").Clear
MsgBox "You must select a country in order to search the database. Please do so in the drop-down list provided."
Sheets("Results").Range("D5").ClearContents
Sheets("Results").Range("D6").ClearContents
Sheets("Results").Range("D7").ClearContents
Exit Sub
'If the country field is filled in and there results from the search made
ElseIf Sheets("Database").Cells(i, 1) = country And _
(Sheets("Database").Cells(i, 3) = Category Or Category = "") And _
(Sheets("Database").Cells(i, 4) = Subcategory Or Subcategory = "") Then
'Copy the headers of the table
With Sheets("Database")
.Range("A1:I1").Copy
End With
Sheets("Results").Range("B10:J10").PasteSpecial
'Copy the rows of the table that match the search query
With Sheets("Database")
.Range(.Cells(i, 1), .Cells(i, 9)).Copy
End With
Sheets("Results").Range("B600").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
'Hides search form
Me.Hide
End If
Next i
'Toggle Results sheet
Sheets("Results").Activate
'Format results as a table
Set rng = Range(Range("B10"), Range("B10").End(xlUp).SpecialCells(xlLastCell))
Set table = Sheets("Results").ListObjects.Add(xlSrcRange, rng, , xlYes)
table.TableStyle = "TableStyleMedium13"
Range("B11").Select
'Make Excel window visible
Application.Visible = True
End Sub
Thank you very much for your help.
You can count from the bottom of the sheet upto the last used cell in column B, and then OFFSET by 1 row. This prevents you needing to worry about
a) that the range to paste to starts from row 12 (they should contain values), and
b) that you are currently using a hard-coded 'anchor' of B600 which will need updating as the data grows.
Sample code:
Dim ws As Worksheet
Dim rngColumnBUsed As Range
Dim lngFirstEmptyRow As Long
Set ws = ThisWorkbook.Sheets("Results")
Set rngColumnBUsed = ws.Range("B" & ws.Rows.Count).End(xlUp).Offset(1, 0)
lngFirstEmptyRow = rngColumnBUsed.Row
Two ListObjects tblDatabase and tblResults
tblResults data gets cleared
A filter is applied to the second, third and fourth columns of tblDatabase
If there are less than 588 results, we copy the filtered records from tblDatabase to tblResults
If there are more than 588 results then we resize the filtered records' range down to the first 588 records and then copy them to tblResults
We never worry about formatting because tblResults keeps it's original format.
Sub ListObjectDemo()
Dim tblDatabase As ListObject, tblResults As ListObject
Set tblDatabase = Worksheets("Database").ListObjects("tblDatabase")
Set tblResults = Worksheets("Results").ListObjects("tblResults")
If Not tblResults.DataBodyRange Is Nothing Then tblResults.DataBodyRange.ClearContents
With tblDatabase.Range
.AutoFilter Field:=2, Criteria1:="Test A"
.AutoFilter Field:=3, Criteria1:="East"
.AutoFilter Field:=4, Criteria1:="Algeria"
End With
With tblDatabase.DataBodyRange
If .Rows.Count <= 588 Then
.Copy tblResults.ListRows.Add.Range
Else
.Resize(588).Copy tblResults.ListRows.Add.Range
End If
End With
End Sub
Dim searchdata as range, inputfromuser as string
inputfromuser = inputbox("type what you wanna search")
set searchdata = sheets("Database").find(inputfromuser).select
searchdata = activecell.value or activecell.offset(10,5).value
sheets("results").activate
with sheets("result")
range("a12",range("a12").end(xldown)).offset(1,0).select
searchdata.copy destination:= activecell
activecell.offset(1,0).select
end with
Not sure, if I understood you corectly mate.
I dont haveexcel sheet or VBE editor. Just wrote this directly on website. Pls amend as per your need.
I need to run Vlookups for data in 2 workbooks. I will open both of my workbooks when running the VBA codes, and I saved both workbooks as .xlsm so they are both macro enabled.
I have no problem using the Vlookup Excel function but I want to run it automatically using VBA code.
Here is the information,
I have 2 workbooks, Book3.xlsm and Book32.xlsm. Book3 is where I want my result to be, as shown in the second picture. The data range varies each month, so I need to loop through the end of the last row.
I have 3 columns in Book3 ID and Type and Result and 2 columns in Book32, ID and Result, and I want to do Vlookup using the ID column in Book3 and get the values in Result columns in Book32. The data are both in Sheet1.
Now my code will run but please look for the first picture where it is not showing the desired result. I can leave the value as #N/A if can't be found but in this case, all the values should be found using Vlookup.
Here is my code,
Sub test()
On Error Resume Next
Dim Res_Row As Integer
Dim Res_Clm As Integer
Dim Table1 As Range
Dim Table2 As Range
Dim cl As Range
Set Table1 = Workbooks("Book3.xlsm").Sheets("Sheet1").Columns("A:C")
Set Table2 = Workbooks("Book32.xlsm").Sheets("Sheet1").Columns("A:B")
Res_Row = Sheet1.Range("C2").Row
Res_Clm = Sheet1.Range("C2").Column
For Each cl In Table1
Sheet1.Cells(Res_Row, Res_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
Res_Row = Res_Row + 1
Next cl
MsgBox "Done"
End Sub
How about this code, which avoids the loop and is easier to read \ maintain.
With Workbooks("Book3.xlsm").Sheets("Sheet1")
Dim lRow as Long
lRow = .Range("A" & .Rows.Count).End(xlup).Row
With .Range("C2:C" & lRow)
.FormulaR1C1 = "=Vlookup(RC[-2],[Book32.xlsm]Sheet1!C1:C2,2,0)"
.Value = .Value
End With
End With
Here it is :
Sub test()
On Error Resume Next
Dim Res_Row As Integer
Dim Res_Clm As Integer
Dim Table1 As Range
Dim Table2 As Range
Set Table1 = Workbooks("Book3.xlsm").Sheets("Sheet1").Columns("A:C")
Set Table2 = Workbooks("Book32.xlsm").Sheets("Sheet1").Columns("A:B")
Res_Clm = 3
The loop will be on each rows of the table1.
For Each i In Table1.Rows
If Sheet1.Cells(i.row, 1) = "" Then Exit For
If there is no data ("") in the cell, the program exit the loop
Sheet1.Cells(i.row, Res_Clm) = Application.WorksheetFunction.VLookup(Sheet1.Cells(i.row, 1), Table2, 2, False)
Next i
Next i increment the i of the for each loop.. It is like i = i+1
MsgBox "Done"
End Sub
You use the wrong argument for the first argument of the vlookup.
Also your loop on "cl" would only work on three rows, so I use row argument.
In general, I would adwise to code your vlookup fonction instead of using Application.WorksheetFunction.VLookup. I'm quite sure it is longer.
I currently have this code which allows me to launch the userform, input the an item in the text box, auto populate the date, and select from a drop down menu
then paste that information into a new row.
The cbm (combo-box) item draws its values from a separate dynamically expanding table and is a drop down menu on the userform. The date is auto populated based on todays date and the text box is draws its value from whatever the user enters.
Private Sub btnSubmit_Click()
Dim ssheet As Worksheet
Set ssheet = ThisWorkbook.Sheets("InputSheet")
nr = ssheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ssheet.Cells(nr, 3) = CDate(Me.tbDate)
ssheet.Cells(nr, 2) = Me.cmblistitem
ssheet.Cells(nr, 1) = Me.tbTicker
My goal here is, depending on what list item is selected I want the name of that item to be pasted in a column that corresponds to that item. i.e if the user selects "apples" and the 3rd column is the "apple" column, I want it to paste in that location.
I am assuming this has to be down with some type of "if" statement.
Any help is appreciated.
Here is pic of my worksheet
supposing I correctly made my guessings, try this code
Option Explicit
Private Sub btnSubmit_Click()
Dim f As Range
If Me.cmblistitem.ListIndex = -1 Then Exit Sub '<--| exit if no itemlist has been selected
If Len(Me.tbTicker) = 0 Then Exit Sub '<--| exit if no item has been input
With ThisWorkbook.Sheets("InputSheet")
Set f = .Rows(1).Find(what:=Me.cmblistitem.Value, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=False) '<--| look for proper column header
If f Is Nothing Then Exit Sub '<--| if no header found then exit
With .Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 1, f.Column) '<--| refer to header column cell corresponding to the first empty one in column "A"
.Resize(, 3) = Array(Me.tbTicker.Value, Me.cmblistitem.Value, CDate(Me.tbDate)) '<--| write in one shot
End With
End With
End Sub
it's commented so you can easily change columns references as per your needs
BTW as for the combobox filling you may want to adopt the following code:
Dim cell As Range
With Me
For Each cell In [myName]
.cmblistitem.AddItem cell
Next cell
End With
which is optimized having referenced Me once before entering the loop so that it's being kept throughout it without further memory accesses
i'm fairly new to VBA and could do with a bit of help. I've looked online and i've found a few bits of code but have been unable to amend to my needs.
I'm trying to create a macro that will enable me to see if their are any duplicate text between column A and B and if the text in column A matches Column B then we will need to delete the entire row. The columns are on the same sheet
I am trying to create a loop that will do this. I must also point out that the length of the list does increase every week
I would appreciate any help
Thank you
Hi try in your code VBA:
Sub DeleteRowWithContents()
'========================================================================
' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "Record Only" IN COLUMN D
'========================================================================
Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) = "Record Only" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
you can update this code for your problem!
I use this when i need deletes all rows from a2 downwards with the words "record only" in column d.
Maybe try this:
Sub DeleteRowWithContents()
Dim ColumnAValue As String
Dim ColumnBValue As String
Dim xlWB As Worksheet
Set xlWB = ActiveWorkbook.ActiveSheet 'If it isn't the active sheet use second row:
'Set xlWB = ActiveWorkbook.Sheets("NameOfSheet") 'Change to the name of your sheet
For i = 1 To EOF 'This goes through the whole document to the last row automatically, EOF means "End Of File"
ColumnAValue = xlWB.Cells(i, 1).Value 'row i, column "a"
ColumnBValue = xlWB.Cells(i, 2).Value 'row i, column "b"
If (ColumnAValue = ColumnBValue) Then
xlWB.Range(ColumnAValue).Select
Selection.EntireRow.Delete 'NOTE!!
End If
Next i
End Sub
NOTE: I'm not too sure if this works, can't test it right now. IF it doesn't, try this instead:
EntireRow.Select
Selection.Delete
I am writing VB code for a Excel form that prompts the user to answer a series of questions and then stores the responses in rows on a sheet. At present the code stores the first response in A2 then second response in B2 and so forth. The sub ends when a thank you prompt appears on the screen.
What I would like to do is when all questions are answered that the cursor will move to the first cell of the next row (A3) to store the answers to the same questions for another person. It must keep on moving to the next row.
These are the main pieces of code
Sub dform ()
Dim mName As String
mName = InputBox("What is your maiden named", "Maiden Name")
Range("A2").Select
ActiveCell.FormulaR1C1 = mName
x = MsgBox("Are you still married?", 4)
If x = 6 Then Range("G2").Value = "Yes"
If x = 7 Then Range("G2").Value = "No"
Exit Sub
End Sub
First of all, you may want to edit your question, as these are asking very different things:
What is your maiden named
What is your maiden name?
I've made a few modifications to your code. The comments should help you understand what is happening. Using this approach allows you to ask your questions without having to select or display the sheet that has all the answers.
I've replaced your hard-coded row with a variable that is set to the first empty row in column A of the ws object. You can set ws to whatever your sheet is called. Now you can run this as many times as you want and it will always append the new answers to a new row.
' use this statement at the top of all modules to require variable declaration
Option Explicit
Sub dform()
' declare your variables
Dim wb As Workbook
Dim ws As Worksheet
Dim firstEmptyRow As Long
Dim mName As String
Dim x As Long
' you need the "set" keyword for object variables
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
' the best way to get the last row is to go up from the bottom of the sheet
' add 1 to get the first empty row
firstEmptyRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1
mName = InputBox("What is your maiden named", "Maiden Name")
' always avoid selecting or activating in VBA code
ws.Range("A" & firstEmptyRow).Value = mName
x = MsgBox("Are you still married?", 4)
If x = 6 Then ws.Range("G" & firstEmptyRow).Value = "Yes"
If x = 7 Then ws.Range("G" & firstEmptyRow).Value = "No"
Exit Sub
End Sub
You might try using the Cells or Offset properties in a loop:
http://msdn.microsoft.com/en-us/library/office/aa139976(v=office.10).aspx
Two possible solutions are:
You store the number of the last used row in a hidden sheet
You "read" the info in the sheet and store the data in the first empty row
I think the first approach is the easiest way to go, and it is persistent (the row number is stored when you save the book).
So, let's assume that you have a sheet called utilitySheet and you store the last row used in cell B2. The value must be an integer, of course.
So your can be something like this:
sub dform()
dim mName as String
dim nRow as Integer
nRow = ThisWorkbook.Sheets("utilitySheet").Cells(2,2).Value
' ...
If x = 6 then ThisWorkbook.Sheets("results").Cells(nRow + 1, 7).Value = "Yes"
If x = 7 then ThisWorkbook.Sheets("results").Cells(nRow + 1, 7).Value = "No"
' ...
' Update the row number in the utility sheet
ThisWorkbook.Sheets("utilitySheet").Cells(2,2).Value = nRow + 1
end sub