I created a variable oldPassword which is populated using a VLookup.
I am trying to get now the cell address from that result but nothing seem to work.
Dim oldPassword As String
oldPassword = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, Worksheets("Employees").Range("A:B"), 2, False)
You should break the task into steps
Get a reference to the cell containing the search value
Use that reference to get the required value and address
Sub Demo
Din rSearch As Range
Dim rUser as Range
Dim rPassword As Range
Dim idx As Variant
Set rSearch = Worksheets("Employees").Range("A:B")
idx = Application.Match(Me.ComboBox1.Value, rSearch.Columns(1), 0)
If Not IsError(idx) Then
Set rUser = rSearch.Cells(idx, 1)
Set rPassword = rUser.Cells(1, 2)
' get the result
oldPassword = rPassword.Value2
' get the address
Debug.Print rPassword.Address
End If
End Sub
I would prefer using .Find as #Andreas suggested but then that is my personal preference.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Employees")
Dim aCell As Range
Set aCell = ws.Columns(1).Find(What:=ComboBox1.Value, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Dim oldPassword As String
If Not aCell Is Nothing Then
With aCell.Offset(, 1)
'~~> Do what you want with that cell
oldPassword = .Value2
MsgBox .Address
End With
Else '<~~ Optional
MsgBox ComboBox1.Value & " not found!"
End If
End Sub
Related
We have two worksheets:
Reference
Operator
Suppose the cell d2 in the Reference sheet contains the value $a$25 .
How to change the value of the cell $a$25 in the Operator sheet using Excel VBA (referencing the address from d2 in the Reference sheet)?
What I have tried:
Capturing the reference in d2 with a variable:
Dim NewRNG as Range
NewRNG = Range(Range("d2").value).value
No luck here.
Finding the reference cell in Operator and using the found cell's address
Sub Find_Cell()
Dim RNG As Range
Dim NewRNG as Range
With Sheets("Operator").Range("A:A")
Set RNG = .Find(What:=Sheets("Reference").Range("d2"), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
NewRNG = RNG.Address
NewRNG.select
End Sub
**in this case, i can't set rng.address to a variable
Like this:
Dim addr As String
addr = Sheets("Reference").Range("D2").Value 'get the cell address
Sheets("Operator").Range(addr).Value = "Test" 'pass the address to Range()
To define the NewRNG variable you have to use "Set"!
Option Explicit
Sub setRange()
Dim NewRNG As Range
Set NewRNG = Range(Range("B2").Value)
Range("B5").Value = NewRNG.Address
Range("B6").Value = NewRNG.Value
Sheets("Operator").Range(Range("B2").Value) = "Test"
End Sub
Sub setRange2() ' variant including a check and error handling
Dim NewRNG As Range
On Error Resume Next
Set NewRNG = Range(Range("B2").Value)
If Err() Then
MsgBox ("You need to set a Range definition (e.g. ""B3"") in field B2!")
Exit Sub
End If
On Error GoTo 0
Range("B5").Value = NewRNG.Address
Range("B6").Value = NewRNG.Value
Sheets("Operator").Range(Range("B2").Value) = "Test"
End Sub
I am trying to write a VBA routine that will take a string, search a given Excel workbook, and return to me all possible matches.
I currently have an implementation that works, but it is extremely slow as it is a double for loop. Of course the built in Excel Find function is "optimized" to find a single match, but I would like it to return an array of initial matches that I can then apply further methods to.
I will post some pseudocode of what I have already
For all sheets in workbook
For all used rows in worksheet
If cell matches search string
do some stuff
end
end
end
As previously stated, this double for loop makes things run very slowly, so I am looking to get rid of this if possible. Any suggestions?
UPDATE
While the below answers would have improved my method, I ended up going with something slightly different as I needed to do multiple queries over and over.
I instead decided to loop through all rows in my document and create a dictionary containing a key for each unique row. The value this points to will then be a list of possible matches, so that when I query later, I can simply just check if it exists, and if so, just get a quick list of matches.
Basically just doing one initial sweep to store everything in a manageable structure, and then query that structure which can be done in O(1) time
Using the Range.Find method, as pointed out above, along with a loop for each worksheet in the workbook, is the fastest way to do this. The following, for example, locates the string "Question?" in each worksheet and replaces it with the string "Answered!".
Sub FindAndExecute()
Dim Sh As Worksheet
Dim Loc As Range
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
Set Loc = .Cells.Find(What:="Question?")
If Not Loc Is Nothing Then
Do Until Loc Is Nothing
Loc.Value = "Answered!"
Set Loc = .FindNext(Loc)
Loop
End If
End With
Set Loc = Nothing
Next
End Sub
Based on Ahmed's answer, after some cleaning up and generalization, including the other "Find" parameters, so we can use this function in any situation:
'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
Dim SearchResult As Range
Dim firstMatch As String
With rng
Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
If Not SearchResult Is Nothing Then
firstMatch = SearchResult.Address
Do
If FindAll Is Nothing Then
Set FindAll = SearchResult
Else
Set FindAll = Union(FindAll, SearchResult)
End If
Set SearchResult = .FindNext(SearchResult)
Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
End If
End With
End Function
Usage is the same as native .Find, but here is a usage example as requested:
Sub test()
Dim SearchRange As Range, SearchResults As Range, rng As Range
Set SearchRange = MyWorksheet.UsedRange
Set SearchResults = FindAll(SearchRange, "Search this")
If SearchResults Is Nothing Then
'No match found
Else
For Each rng In SearchResults
'Loop for each match
Next
End If
End Sub
Function GetSearchArray(strSearch)
Dim strResults As String
Dim SHT As Worksheet
Dim rFND As Range
Dim sFirstAddress
For Each SHT In ThisWorkbook.Worksheets
Set rFND = Nothing
With SHT.UsedRange
Set rFND = .Cells.Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rFND Is Nothing Then
sFirstAddress = rFND.Address
Do
If strResults = vbNullString Then
strResults = "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")"
Else
strResults = strResults & "|" & "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")"
End If
Set rFND = .FindNext(rFND)
Loop While Not rFND Is Nothing And rFND.Address <> sFirstAddress
End If
End With
Next
If strResults = vbNullString Then
GetSearchArray = Null
ElseIf InStr(1, strResults, "|", 1) = 0 Then
GetSearchArray = Array(strResults)
Else
GetSearchArray = Split(strResults, "|")
End If
End Function
Sub test2()
For Each X In GetSearchArray("1")
Debug.Print X
Next
End Sub
Careful when doing a Find Loop that you don't get yourself into an infinite loop... Reference the first found cell address and compare after each "FindNext" statement to make sure it hasn't returned back to the first initially found cell.
You may use the Range.Find method:
http://msdn.microsoft.com/en-us/library/office/ff839746.aspx
This will get you the first cell which contains the search string. By repeating this with setting the "After" argument to the next cell you will get all other occurrences until you are back at the first occurrence.
This will likely be much faster.
Based on the idea of B Hart's answer, here's my version of a function that searches for a value in a range, and returns all found ranges (cells):
Function FindAll(ByVal rng As Range, ByVal searchTxt As String) As Range
Dim foundCell As Range
Dim firstAddress
Dim rResult As Range
With rng
Set foundCell = .Find(What:=searchTxt, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not foundCell Is Nothing Then
firstAddress = foundCell.Address
Do
If rResult Is Nothing Then
Set rResult = foundCell
Else
Set rResult = Union(rResult, foundCell)
End If
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
End If
End With
Set FindAll = rResult
End Function
To search for a value in the whole workbook:
Dim wSh As Worksheet
Dim foundCells As Range
For Each wSh In ThisWorkbook.Worksheets
Set foundCells = FindAll(wSh.UsedRange, "YourSearchString")
If Not foundCells Is Nothing Then
Debug.Print ("Results in sheet '" & wSh.Name & "':")
Dim cell As Range
For Each cell In foundCells
Debug.Print ("The value has been found in cell: " & cell.Address)
Next
End If
Next
You can read the data into an array. From there you can do the match in memory, instead of reading one cell at a time.
Pass cell contents into VBA Array
Below code avoids creating infinite loop. Assume XYZ is the string which we are looking for in the workbook.
Private Sub CommandButton1_Click()
Dim Sh As Worksheet, myCounter
Dim Loc As Range
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
Set Loc = .Cells.Find(What:="XYZ")
If Not Loc Is Nothing Then
MsgBox ("Value is found in " & Sh.Name)
myCounter = 1
Set Loc = .FindNext(Loc)
End If
End With
Next
If myCounter = 0 Then
MsgBox ("Value not present in this worrkbook")
End If
End Sub
I have the following code I use to go through a sheet and parse the information onto separate sheets based on the string [Start].
Private Sub CommandButton7_Click()
Application.ScreenUpdating = False
Dim i As Long, rFind As Range, rFind1 As Range, rFind2 As Range, rFind3 As Range, rFind4 As Range, ws As Worksheet, s As String, s1 As String, s2 As String
s = "[Start]"
With Sheets("Full History File").Columns(1)
Set rFind3 = .Find(What:="[HistoryEnd]", LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
Set rFind = .Cells(Rows.Count, 1)
For i = 1 To WorksheetFunction.CountIf(.Cells, "*" & s & "*")
Set rFind = .Find(What:=s, After:=rFind, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
Set rFind1 = .Find(What:=s, After:=rFind)
Set ws = Worksheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Blasted " & i
If i = WorksheetFunction.CountIf(.Cells, "*" & s & "*") Then
Set rFind1 = rFind2.Offset(1)
End If
Range(rFind, rFind1.Offset(-1)).Copy ws.Range("A1")
End If
Next i
End With
Sheets("Blast Summary Sheet").Select
SheetNames
CommandButton6.Visible = True
Application.ScreenUpdating = True
End Sub
My problem is that the information I am working through has changed and I need to adapt the code to do the following:
Search for the string [TrainingModeChanged]
If not found search for the string [TrainingMode]
If not found search for the string [Start]
Once any of the strings are found create the new sheet Blasted with the number and copy the information between the found string up until the next found string which could be either one of the 3 above.
All help in modify the code to do this would be helpfull thanks
I am not entirely sure what you are after, but you could write a function that returns your required string instead of hardcoding it. Function below:
Option Explicit
Function getString() As String
'we will use On Error Resume Next to by pass the expected error if cannot find the string
On Error Resume Next
Dim searchRng As Range
Dim mySheet As Worksheet
Set mySheet = ThisWorkbook.Sheets("Full History File")
'search for first range
Set searchRng = mySheet.Columns(1).Find(What:="[TrainingModeChanged]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
'reset error handling
On Error GoTo 0
Exit Function
End If
'implicit to say if program runs here first search was unsuccessful
Set searchRng = mySheet.Columns(1).Find(What:="[TrainingMode]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
On Error GoTo 0
Exit Function
End If
'implicit to say if program runs here second search was unsuccessful
Set searchRng = mySheet.Columns(1).Find(What:="[Start]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
On Error GoTo 0
Exit Function
End If
End Function
And you call in your routine as:
s = getString()
And then continue on with your code..
I have a table of data in a sheet that i am looking to make some adjustments to. I have a single column called "S/R" which will have one of two values in it [Serving OR Returning]. If the value is serving i want to copy the value from a column called "1stServeX" to a new column i have added i called "Server 1st Serve X".
I have written the code below but am beginning to trip myself up and also cannot finish the last part. I am a novice and so have been using other pieces of code i have gained previously to try and piece it together, which is why i need some help.
If i can get this going then i can simply repeat it for all the "Returner" option and all the other columns i need to split too.
Thanks in advance for any help offered.
Public Sub splitServerCoordinates()
'Set a constant for the title of the Server Column
Const HEADER_SR As String = "S/R"
Dim ws As Worksheet
Set ws = Sheets("transition")
Dim strSearch As String
Dim aCell As Range
Dim COL_SR As Long
Dim COL_TARGET As Long
Dim COL_CURRENT As Long
'Find the Column Numbers of the columns we are looking for
strSearch = "S/R"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_SR = aCell.Column
End If
strSearch = "1stServeX"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_CURRENT = aCell.Column
End If
strSearch = "Server 1st Serve X"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_TARGET = aCell.Column
End If
Dim theUsedRange As Range
Dim SRRange As Range
Dim aPlayer As Range
Dim serving As String
Dim returning As String
Dim theCounter As Long
Dim theSequence As Long
ws.Select
' clear out the Target column and add the header again
Set theUsedRange = ActiveSheet.UsedRange
Intersect(theUsedRange, Range(Columns(COL_TARGET), Columns(COL_TARGET))).ClearContents
Columns(COL_SR).Range("A1").Value = HEADER_SR
' reset the used range just in case
Set theUsedRange = ActiveSheet.UsedRange
' Get the used range for the S/R column
Set SRRange = Intersect(theUsedRange, Columns(COL_SR))
'Set value to compare to
serving = "Serving"
' Loop through the S/R column
For Each aPlayer In SRRange
' ignore the header row
If aPlayer <> HEADER_SR Then
' if we are serving then copy the value from COL_CURRENT to COL_TARGET
If aPlayer = serving Then
aPlayer.Offset(-1, COL_TARGET - COL_).Value = STUCK - HERE
End If
End If
Next aPlayer
End Sub
Some refactoring to pull out the column header location parts, and a few other tweaks. Untested, but should get you there.
Public Sub splitServerCoordinates()
Dim ws As Worksheet, c As Range
Dim COL_SR As Long
Dim COL_TARGET As Long
Dim COL_CURRENT As Long
Set ws = Sheets("transition")
'Find the Column Numbers of the columns we are looking for
COL_SR = HeaderColumnNumber(ws.Rows(1), "S/R")
COL_CURRENT = HeaderColumnNumber(ws.Rows(1), "1stServeX")
COL_TARGET = HeaderColumnNumber(ws.Rows(1), "Server 1st Serve X", True) 'add if not found
'exit if missing any required columns
If COL_SR = 0 Or COL_CURRENT = 0 Then
MsgBox "Missing 'S/R' and/or '1stServeX' !"
Exit Sub
End If
'reset target column
ws.Columns(COL_TARGET).ClearContents
ws.Cells(1, COL_TARGET).Value = "Server 1st Serve X"
'loop rows
For Each c In ws.Range(ws.Cells(2, COL_SR), ws.Cells(ws.Rows.Count, COL_SR).End(xlUp)).Cells
If c.Value = "Serving" Then
ws.Cells(c.Row, COL_TARGET).Value = ws.Cells(c.Row, COL_CURRENT).Value
End If
Next c
End Sub
'Find a header position on a row, with option to add it if not found
' Returns zero if header is not found and option to add was not set
Function HeaderColumnNumber(rng As Range, hdr As String, _
Optional AddIfMissing As Boolean = False) As Long
Dim f As Range
Set rng = rng.Cells(1).EntireRow 'only want a full row to look in
Set f = rng.Find(What:=hdr, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
HeaderColumnNumber = f.Column 'found: return column
Else
'not found: do we add it, or return zero?
If AddIfMissing Then
With rng.Cells(rng.Cells.Count).End(xlToLeft).Offset(0, 1)
.Value = hdr
HeaderColumnNumber = .Column
End With
Else
HeaderColumnNumber = 0
End If
End If
End Function
I have some VBA experience, I can read and understand the coding, but have problems finding the proper codes.
Now, I have a userform where by the user would key in his ID, excel would then open up the database and search and return the results of the cells beside the found ID. the results would be returned and overwrite label 1 and label 2. And when the user clicks on the "next" or "previous" button, the next or previous results would then overwrite both labels.
The code I have right now allows me to search for the locations of the found ID and output the location in a format such as ($A$2,$A$3,$A$4,$A$6). The problem is that I am not sure what is the right functions that can then break this into individual range that the "next" or "previous" button can then refer to.
Have added my code
Dim cell As Range
Dim bcell As Range
Dim foundat As String
Dim oRange As Range
Dim userid As String
Dim x As Long
Dim y As Long
Dim Prob As String
Dim ws As Worksheet
Set ws = Worksheets("OFI")
Set oRange = ws.Columns(1)
userid = txt_user.Text
Set cell = oRange.Find(what:=userid, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
Set bcell = cell
foundat = cell.Address
Do
Set cell = oRange.FindNext(after:=cell)
If Not cell Is Nothing Then
If cell.Address = bcell.Address Then Exit Do
foundat = foundat & ", " & cell.Address
Else
Exit Do
End If
Loop
Else
msgbox userid & "not found"
Exit Sub
End If
capproblem_output.Caption = foundat
Exit Sub
You need to add two command buttons with name cmdNext & cmdPrev , label with name capproblem_output2 to run the below code. Copy the code to userform code section.
Public foundat As String
Private Sub cmdNext_Click()
capproblem_output.Caption = ActiveCell.Offset(1, 1)
capproblem_output2.Caption = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
End Sub
Private Sub cmdPrev_Click()
capproblem_output.Caption = ActiveCell.Offset(-1, 1)
capproblem_output2.Caption = ActiveCell.Offset(-1, 1)
ActiveCell.Offset(-1, 0).Select
End Sub
Private Sub CommandButton1_Click()
Main
End Sub
Sub Main()
Dim cell As Range
Dim bcell As Range
Dim oRange As Range
Dim userid As String
Dim x As Long
Dim y As Long
Dim Prob As String
Dim ws As Worksheet
Set ws = Worksheets("OFI")
Set oRange = ws.Columns(1)
userid = UserForm1.txt_user.Text
Set cell = oRange.Find(what:=userid, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
Set bcell = cell
foundat = cell.Address
Do
Set cell = oRange.FindNext(after:=cell)
If Not cell Is Nothing Then
If cell.Address = bcell.Address Then Exit Do
foundat = foundat & ", " & cell.Address
Else
Exit Do
End If
Loop
Else
MsgBox userid & "not found"
Exit Sub
End If
capproblem_output.Caption = Range(foundat).Offset(0, 1)
capproblem_output2.Caption = Range(foundat).Offset(0, 1)
End Sub