I am working on Excel macro. What i need when getting data from another excel sheet, code should first check if there is any other row with the same FundName and if found then conditions apply.
I am just giving the sample of Excel Sheet from which the FundId is to be checked :
S.No Funds
1 A
2 B
3 C
4 D
5 A
Code is given below:
Set shtData = wbraw.Sheets(1) ' this line is correct
Set CCell = shtData.Cells.Find("Funds", LookIn:=xlValues, LookAt:=xlWhole).Offset(1, 0)
Set DCell = CCell.End(xlDown)
Dim SearchString as String
SearchString = "A"
Set FindRow = shtData.Range(CCell, DCell).Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set NextRow = shtData.Range(CCell, DCell).FindNext(After:=FindRow)
Above two lines in code not working as i want it should be. Let say if SearchString is set to "A" then FindRow and NextRow both should have the value. And if SearchString is set to "B" then as per given excel sheet FindRow should have the value but NextRow returns Nothing so that I can apply my conditions.
Please if anyone can help me.
Find will use the first cell of Range for the After parameter, if it is not specified, therefore the search is started after B2, and thus the first cell it finds is B6.
If the order is important for you then call Find with the last cell provided as After:
Dim counter As Integer
counter = 0
With shtData.Range(CCell, DCell)
Set c = .Find(SearchString, LookIn:=xlValues, LookAt:=xlWhole, After:=DCell)
If Not c Is Nothing Then
firstAddress = c.Address
Do
counter = counter + 1
Debug.Print "The next match #" & counter & " is " & c.Address
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Replace this:
Set FindRow = shtData.Range(CCell, DCell).Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set NextRow = shtData.Range(CCell, DCell).FindNext(After:=FindRow)
With:
If WorksheetFunction.CountIf(CCell.EntireColumn, SearchString) > 1 Then
'Duplicate found, do something here
Else
'Unique string, do something here
End If
Or
If Evaluate("COUNTIF(" & CCell.EntireColumn.Address & "," & SearchString & ")") > 1 Then
'Duplicate found, do something here
Else
'Unique string, do something here
End If
Related
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 two sheets in excel, one is a board with several cells with numbers inside, and the other is references (that have the numbers in previous board) and i need to write in same line of the references where are the cells located.
image of the first board where are the references
image of the excel sheet that i have to write the location of each reference
my vba code
Example:
The arm8.png is the board and local.png is where i write de localizations of the cells
Option Explicit
Sub ciclo()
Dim FindString As String
Dim Rng As Range
Dim matrixVal As Range
Set matrixVal = Sheets("Localizações").Range("B1")
FindString = matrixVal
For Each Rng In matrixVal
If Trim(FindString) <> "" Then
With Sheets("Arm8").Range("A1:J10")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'Application.Goto Rng, False
'MsgBox Rng.Column & " - " & Rng.Row
Else
MsgBox "Nothing found"
End If
End With
With Sheets("Localizações")
.Range("C1:C9").Value = Rng.Column
.Range("D1:D9").Value = Rng.Row
End With
End If
Next Rng
End Sub
I expected the output in local.png to be column C and D
2 - 9
2 - 7
2 - 8
2 - 4
5 - 4
7 - 4
5 - 9
9 - 7
9 - 0
Firstly, as I said in my comment, this:
Set matrixVal = Sheets("Localizações").Range("B1")
sets matrixVal as one single cell (B1 to be precise), so your For-Each loop doesn't have any cells to loop through apart from this single cell, so it will only run once.
Second, the FindString needs to be updated inside the loop, otherwise you'll be searching for the same value over and over.
Finally, you shouldn't update the Rng variable inside the loop because you are already using it to loop through a range. You need a second variable of type Range.
Your code should look like:
Sub ciclo()
Dim FindString As String
Dim Rng As Range
Dim cell As Range
Dim matrixVal As Range
Set matrixVal = ThisWorkbook.Worksheets("Localizacoes").Range("B1:B9")
For Each cell In matrixVal
FindString = cell.Value
If Trim(FindString) <> "" Then
With ThisWorkbook.Worksheets("Arm8").Range("A1:J10")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
With ThisWorkbook.Worksheets("Localizacoes")
.Cells(cell.Row, "C").Value = Rng.Column
.Cells(cell.Row, "D").Value = Rng.Row
End With
Else
MsgBox "Nothing found"
End If
End With
End If
Next cell
End Sub
I'm new to VBA in Excel and have a fairly simple issue. I need to search for specific text string Bath in Column B. If it exists, then I need to replace specific text string KCab in Column C of the same row with BCab3. I need to run or loop this until it checks all the cells in Column B.
Here is what I have so far, which is not working:
Sub Correct_Attribute_Suffix()
Dim c As Range
Dim SrchRng
Set SrchRng = ActiveSheet.Range("B3", ActiveSheet.Range("B65536").End(xlUp))
Do
Set c = SrchRng.Find("BATH", LookIn:=xlValues)
If Not c Is Nothing Then Currentcell.Offset(, 1).Value = Replace("KCab", "K", "B")
Loop While Not c Is Nothing
End Sub
This is just a Find/FindNext operation using offset and replace to accomplish your attribute suffix adjustment.
Sub Correct_Attribute_Suffix()
Dim fnd As Range, addr As String
With ActiveSheet.Range("B3", ActiveSheet.Range("B65536").End(xlUp))
Set fnd = .Find(What:="BATH", After:=.Cells(.Cells.Count), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not fnd Is Nothing Then
addr = fnd.Address
Do
fnd.Offset(0, 1) = Replace(fnd.Offset(0, 1).Value2, "KCab", "BCab3", 1, 1, vbTextCompare)
Set fnd = .FindNext(After:=fnd)
Loop While addr <> fnd.Address
End If
End With
End Sub
I am trying to use the Range.Find method in VBA to locate the closest previous row number that has a "true" value.
For example, in Column X, there will be a "true" value (row 35), 10 rows with "false," and then "true" again (row 46).
When I get to row 46 in my loop, I need to do a range.find and return row 35.
The code I am using is this:
Worksheets("Data").Cells.Find(True, searchorder:=xlByColumns, searchdirection:=xlNext).Row
What is happening is that I am only finding either the very first "true" value (in this case, row 2), or the very last "true" value (row 24,xxx), as I vary search direction.
What can I do to find only the previous-most "true" value?
You can find the previous row with True by using the After argument in the Find method combined with xlPrevious as the SearchDirection. I have updated the code to add it into a loop, based on your comments.
Since you posted your code, I have edited my answer into your code.
Sub Main()
Dim iCurRow As Long
Dim iCounter As Long
Dim iLastRow As Long
Dim iTempRow As Long
Dim iPreviousRow As Long
Dim iChangeCol As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")
With ws
iChangeCol = .Cells.Find(what:="Change Over?", searchorder:=xlByColumns, searchdirection:=xlNext).Column
iLastRow = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
iPreviousRow = 2
For iCounter = 3 To iLastRow
If .Cells(iCounter, iChangeCol).Value = True Then
iTempRow = .Cells.Find(what:=True, After:=.Cells(iCounter, iChangeCol), searchorder:=xlByColumns, searchdirection:=xlPrevious).Row
iPreviousRow = iTempRow
End If
Next iCounter
End With
End Sub
This short snippet uses both the Range.Find method and Range.FindNext method to cycle through all matching cells in column X.
Sub rings_true()
Dim fnd As Range
With Worksheets("Sheet1") `<~~ set this worksheet reference properly
With .Columns(24)
Set fnd = .Find(What:="TRUE", after:=.Cells(.Rows.Count), _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Do While Not fnd Is Nothing
If MsgBox("Currently at " & fnd.Address(0, 0) & Chr(10) & "exit now...?", vbYesNo + vbQuestion) = vbYes Then
Exit Do
Else
Set fnd = .FindNext(after:=fnd)
End If
Loop
End With
End With
End Sub
The current cell address is reported through a MsgBox function. The same MsgBox offers the user the opportunity to break the loop.
Additional error control might include confirming at least one matching value in column X before entering into the loop.
There are multiple arguments to put into the Find method, regarding what you told us, I suggest that you use :
After:=.Cells(.Rows.Count, 1) to start from the bottom of the column
LookIn:=xlValues
LookAt:=xlWhole
SearchOrder:=xlByRows to look row by row (instead of column by column)
SearchDirection:=xlPrevious to look "back", from bottom to top
MatchCase:=False
SearchFormat:=False
And furthermore, you can use the .Find method into a specific range, so rather than Worksheets("Data").Cells.Find(..., you should use Worksheets("Data").Range("X:X").Find(... to look only in the column X.
Here is your amended code :
Sub test_ilarson007()
Dim FirstAddress As String, PreviousMatch As Range, cF As Range
Worksheets("Data").Activate
With Worksheets("Data").Range("X:X")
'First, define properly the Find method
Set cF = .Find(What:=True, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False, _
SearchFormat:=False)
'If there is a result,
If Not cF Is Nothing Then
FirstAddress = cF.Address
MsgBox "The row containing the previous 'True' in Column X is : " & cF.Row
'keep looking with FindNext method : Not usefull for your example
Do
Set PreviousMatch = cF
Set cF = .FindNext(cF)
'-------------------------------------------------------------
'----Place instructions to execute on the matched cell/row/...
'First match (i.e. Row 46 in your example)
MsgBox PreviousMatch.Row 'Should display 46 (then 35, then ??)
'Second match (i.e. Row 35 in your example)
MsgBox cf.Row 'Should display 35 (then ??, then ??)
'-------------------------------------------------------------
'Look until you find again the first result
Loop While Not cF Is Nothing And cF.Address <> FirstAddress
End If
End With
End Sub
All. I am new to VBA and MS EXCEl 2010. I just started to play with the macro module in EXCEL yesterday, almost zero experience.
What I was trying to do is described as follows. First search for value records in a range in sheet1, then for each cell I found, I locate that row and pull out another cell value at that row. Using this value to do another search in a range in sheet2. I'll point out the problem I am having after my code. Here is the pesudcode.
Dim Found As Range
With RangeInSheet1
Set Found = .Find(value1)
If Not Found Is Nothing Then
firstAddress = Found.Address
Do
With RangeInSheet2
ColumnIndex = .Find(value2).Column
End With
Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found.Address <> firstAddress
End If
End With
value1 is the key I used to search in RangeSheet1, and value2 in RangeSheet2. The above code goes through every record I found for value1 in sheet 1 and do another search in Sheet2.
Now let's Say value1 = 1, value2 =2007, and there are 5 records that contains value1 in sheet 1. The problem arises from this line of code "ColumnIndex = .Find(value2).Column".
Supposedly, for all the five found records, value of Found should always be 1 after "Set Found = .FindNext(Found)" is executed . But, after I added this ColumnIndex code, value of Found is set to 2007, which is so weird to me. Anyone knows what the problem is? Any help will be appreciate. I really need to keep the Found behaves "normal" as I want.
If anything is unclear, please let me know
.Find/.Findnext remembers the last setting. And hence it is always advisable to completely Specify the parameters. specially After:= parameter. It will also remember what was your last search term i.e What:=
Here is a demonstration on how to work with .Find/.Findnext
Also do not use Value2 as a variable. It is a reserved word. Instead of using Value1 and Value2, I am using sSearch1 and sSearch2 in the below code
Let's say your sheets look like this
Now Try this code
Sub Sample()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngWs1 As Range, rngWs2 As Range
Dim aCell As Range, bCell As Range, cCell As Range, dCell As Range, eCell As Range, cl As Range
Dim sSearch1, sSearch2
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set rngWs1 = ws1.Range("A1:A10")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set rngWs2 = ws2.Cells
With ws1
For i = 1 To 10
sSearch1 = .Range("A" & i).Value
Set aCell = .Range("A" & i)
If Len(Trim(sSearch1)) <> 0 Then
Set aCell = rngWs1.Find(What:=sSearch1, After:=aCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
sSearch2 = aCell.Offset(, 1).Value
With ws2
Set bCell = rngWs2.Find(What:=sSearch2, After:=.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not bCell Is Nothing Then
Debug.Print "For " & sSearch1 & ", " & sSearch2 & " Found in " & bCell.Address
Set cCell = bCell
Do
Set bCell = rngWs2.FindNext(After:=bCell)
If Not bCell Is Nothing Then
If bCell.Address = cCell.Address Then Exit Do
Debug.Print "For " & sSearch1 & ", " & sSearch2 & " Found in " & bCell.Address
Else
Exit Do
End If
Loop
End If
End With
End If
End If
Next
End With
End Sub
This is the result that we get.