Find cells that have common values in vba - excel

I am attempting to write a macro that will loop over a column and take each cell and find all the other cells that are approximate matches and move them to another spread sheet. I thought of using the find method but I am unsure how to implement it for this. I have pasted what I have done so far, which isn't much. I am rather new to vba so any help would be greatly appreciated.
Sub Extract()
Dim i As Long, count As Long, rng1 As Range
Set rng1 = Sheet1.Range(Range("N1"), Range("N1").End(xlDown))
count = 2
For i = 1 To Sheet1.Range(Range("N1"), Range("N1").End(xlDown)).Rows.count
Sheet1.Cells(count, 14).Select
count = count + 1
Next i
End Sub

This is a bare-bones solution to get you going. Bare-bones because things like search string, search column, worksheets etc. are hard coded. The 'matches' are placed in a worksheet called 'Matches' in the same 'position' as the 'Data' sheet (Col A) from which they have been extracted.
Sub findlikes()
Dim wsDat As Worksheet, wsMat As Worksheet
Dim strSearch As String, firstAdd As String
Dim fndCell As Range
Dim srchCol As Long, numFnd As Long
Set wsDat = Sheets("Data")
Set wsMat = Sheets("Matches")
srchCol = 1 'Col A
strSearch = "Alka-Seltzer"
Set fndCell = wsDat.Columns(srchCol).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not fndCell Is Nothing Then
firstAdd = fndCell.Address
numFnd = 1
Do
wsMat.Range(fndCell.Address).Value = fndCell.Value
Set fndCell = wsDat.Columns(srchCol).FindNext(fndCell)
numFnd = numFnd + 1
Loop While Not fndCell Is Nothing And fndCell.Address <> firstAdd
Else
MsgBox "Search String Not Found"
End If
End Sub
This approach used the Find (and FindNext) methods that you mentioned in your original post.
Further references to these can be found here and here.

Related

Find range of cells, when given 2 Dates

I have a table with numbers from 1 to 10. (Starting from D2 to M2)
Suppose in A1 there is 03/09/2019
AND in B1 there is 06/09/2019
AND in C1 there is Hello
In COLUMN A I have a multiple series of words starting from A3 to A10
Here is an Example of the Excel Table
What I would like to do is: Search for the word Student in Column A, when I find it, get the numbers from A1 --> 3
and A2 --> 6 and write the word Hello that is in C1 in the cells that go to 3 to 6 in the row of the finded word Student
So my output would be like:
This is my code so far:
Dim Cell As Range
Columns("A:A").Select
Set Cell = Selection.Find(What:="Student", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Cell Is Nothing Then
MsgBox "Word not found"
Else
MsgBox "Word found"
End If
Basically I can find the word Student but don't know how to write the word Hello in the cells between 3 to 6
A few notes regarding the code below (not tested!).
1) Always try use worksheet qualifiers when working with VBA. This will allow for cleaner code with less room for unnecessary errors
2) When using .Find method I use LookAt:=xlWhole because if you do not explicitly define this your code will use the last known method that you would have used in Excel. Again, explicit definition leaves less room for error.
3) Try include error handling when you code. This provides “break points” for easier debugging in the future.
4) You can make the below much more dynamic that it currently is. But I'll leave that up to you to learn how to do!
Option Explicit
Sub SearchAndBuild()
Dim rSearch As Range
Dim lDayOne As Long, lDayTwo As Long
Dim lColOne As Long, lColTwo As Long
Dim sHello As String
Dim wsS1 As Worksheet
Dim i As Long
'set the worksheet object
Set wsS1 = ThisWorkbook.Sheets("Sheet1")
'store variables
lDayOne = Day(wsS1.Range("A1").Value)
lDayTwo = Day(wsS1.Range("B1").Value)
sHello = wsS1.Range("C1").Value
'find the student first
Set rSearch = wsS1.Range("A:A").Find(What:="Student", LookAt:=xlWhole)
'error handling
If rSearch Is Nothing Then
MsgBox "Error, could not find Student."
Exit Sub
End If
'now loop forwards to find first date and second date - store column naumbers
'adjust these limits where necessary - can make dynamic
For i = 4 To 13
If wsS1.Cells(2, i).Value = lDayOne Then
lColOne = i
End If
If wsS1.Cells(2, i).Value = lDayTwo Then
lColTwo = i
Exit For
End If
Next i
'now merge the range
wsS1.Range(wsS1.Cells(rSearch.Row, lColOne), wsS1.Cells(rSearch.Row, lColTwo)).Merge
'set the vvalue
wsS1.Cells(rSearch.Row, lColOne).Value = sHello
End Sub
This is just one way to approach the problem. Hopefully this helps your understanding!
No need for a loop here - just find your value and parse the dates. Assuming your value to be found exists in Column A and your table starts in Column D, there is clear relationship between the columns which is Day(date) + 3.
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, Found As Range
Dim date_a As Long, date_b As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set Found = ws.Range("A2:A" & lr).Find("Student", LookIn:=xlValues)
If Not Found Is Nothing Then
date_a = Day(Range("A1")) + 3
date_b = Day(Range("B1")) + 3
With ws.Range(ws.Cells(Found.Row, date_a), ws.Cells(Found.Row, date_b))
.Merge
.Value = ws.Range("C1")
End With
Else
MsgBox "Value 'Student' Not Found"
End If
End Sub
I've tried this:
Dim ThisRow As Long
Dim FindWhat As String
FindWhat = "Student"
Dim MyStart As Byte
Dim MyEnd As Byte
MyStart = Day(Range("A1").Value) + 3 'we add +3 because starting 1 is in the fourth column
MyEnd = Day(Range("B1").Value) + 3 'we add +3 because starting 1 is in the fourth column
Dim SearchRange As Range
Set SearchRange = Range("A3:A10") 'range of values
With Application.WorksheetFunction
'we first if the value exists with a count.
If .CountIf(SearchRange, FindWhat) > 0 Then 'it means findwhat exists
ThisRow = .Match(FindWhat, Range("A:A"), 0) 'we find row number of value
Range(Cells(ThisRow, MyStart), Cells(ThisRow, MyEnd)).Value = Range("C1").Value
Application.DisplayAlerts = False
Range(Cells(ThisRow, MyStart), Cells(ThisRow, MyEnd)).Merge
Application.DisplayAlerts = True
Else
MsgBox "Value 'Student' Not Found"
End If
End With
Note I've used worksheets function COUNTIF and MATCH. MATCH will find the position of an element in a range, so if you check the whole column, it will tell you the row number. But if it finds nothing, it will rise an error. Easy way to avoid that is, first, counting if the value exists in that range with COUNTIF, and if it does, then you can use MATCH safely
Also, note that because we are using MATCH, this function only finds first coincidence, so if your list of values in column A got duplicates, this method won't work for you!.

AdvancedFilter to filter one variable at the same time in three columns (vba)

I would like to filter thee columns at the same time based on one variable. I use this filter inside a loop to create pdf files that contain data based on this filter.(I removed the code of creating pdf)
Let's see the following example:
Name1 Name2 Name3
Michael George Annet
George Michael Michael
Michael Jorge Annet
Jorge Annet Michtel
There are 3 columns with names, I would like to filter these three columns based on a variable that holds a name. So for example name = "George" then I would like to see every line that contains the name "George" The output looks then:
Name1 Name2 Name3
Michael George Annet
George Michael Michael
I tried the following:
Set ws1 = Worksheets("Rooster")
For i = 1 To SelectionCount
name = NameArray(i)
If ws1.FilterMode Then ws1.ShowAllData
ws1.Range("AB8:AD157").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=name, _
Unique:=False
Next i
NameArray(i) is an array that contains all names that are selected by the user. (NameArray() is a function that is called)
SelectionCount counts the number of selected cells by the user.
("AB8:AD157") is the range of three columns where Excel should search for the variable.
There is no error when running this code, but nothing is filtered. What is wrong? Or is the AdvancedFilter not the right choice to use?
afaik, you cannot use an array as the parameter in a Range.AdvancedFilter method¹. However, it doesn't seem too much of a stretch to mimic the .AdvancedFilter process entirely within VBA memory and range references.
Sub pseudoAdvancvedFilter()
Dim n As Long, fnd As Range, rng As Range, addr As String, vNAMEs As Variant
vNAMEs = Array("george", "annet")
With Worksheets("Rooster")
With Range("AB8:AD157")
.EntireRow.Hidden = False
For n = LBound(vNAMEs) To UBound(vNAMEs)
Set fnd = .Cells.Find(What:=vNAMEs(n), LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False)
If Not fnd Is Nothing Then
addr = fnd.Address
If rng Is Nothing Then Set rng = fnd
Do
Set rng = Union(rng, fnd)
Set fnd = .Cells.FindNext(After:=fnd)
Loop Until addr = fnd.Address
End If
addr = vbNullString
Set fnd = Nothing
Next n
If Not rng Is Nothing Then
'Debug.Print rng.Address(0, 0)
.EntireRow.Hidden = True
rng.EntireRow.Hidden = False
End If
End With
End With
End Sub
After collecting all of the matches to names listed in the array with a looped Range.Find method and Union method, the entire range is hidden then the union of matched cells is used to undie the matching rows.
                       Before running pseudoAdvancvedFilter                    After running pseudoAdvancvedFilter
¹ See Can Advanced Filter criteria be in the VBA rather than a range? for more information and alternate methods.
I got from OP's Q that he wanted to hide any row not containing ALL of the names in NameArray. If that is actually his need then here's my solution
Option Explicit
Sub FilterMoreColumnsByName()
Dim iName As Long
Dim dataRng As Range, cell As Range, fnd As Range
Dim nameArray As Variant, name As Variant
nameArray = Array("george", "annet") ' <== it will be hidden any row NOT containing ALL of these names
With Worksheets("Rooster")
For iName = LBound(nameArray) To UBound(nameArray)
name = nameArray(iName)
Set dataRng = .Range("AB8: AB157").SpecialCells(xlCellTypeVisible) ' so as not to loop uselessly on rows that didn't match some previous name
Set fnd = .Cells(1, 1) ' add a "dummy" cell to prevent Union method to fail the first time -> it will be hidden -> it must be unhidden before exiting sub
For Each cell In dataRng
If cell.Resize(, 3).Find(What:=name, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) Is Nothing Then Set fnd = Application.Union(fnd, cell)
Next cell
fnd.EntireRow.Hidden = True
Next iName
.Rows(1).Hidden = False 'show the "dummy" cell row
End With
End Sub

How to search and replace using VBA in Excel?

I am new to VBA Excel programming. Consider an Excel sheet with nxn values. My task is to search for text called "TOOTHBRUSH BATT" from A column. A column consists of multiple "TOOTHBRUSH " value.
Once the value is found suppose in cell A11 then I need to change text in D11 ie corresponding D column to "BATTERY". D11 will already have some text, I need to replace that text with "BATTERY"
My code is
Sub replacement()
Dim S As String
Dim H As String
S = "TOOTHBRUSH BATT"
For i = 1 To Range("A1").End(xlDown).Row
If Range("A" & i) = S Then
Range("D" & i) = "BATTERY"
End If
Next i
End Sub
nRow = Worksheets(1).Range("A:A").Find(What:="*TOOTHBRUSH BATT*", after:=Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Row
Worksheets(1).Cells(nRow,"D") = "BATTERY"
By using auto filter (below code not tested)
Worksheets(1).autofiltermode = false
Worksheets(1).Range("A:B").autofilter
Worksheets(1).AutoFilter.Range.AutoFilter Field:=1, Criteria1:="*TOOTHBRUSH BATT*"
dim nRng as range
If Worksheets(1).AutoFilter.Range.Offset(1,0).Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
set nRng = Worksheets(1).AutoFilter.Range.Offset(1,0).Columns(2).Resize(Worksheets(1).AutoFilter.Range.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
nRng.value = "BATTERY"
End If
This is Similar to Eric's Answer.
' Declare range to set to the first cell we find
Dim find as Range
set find = Range("A:A").Cells.Find(What:="TOOTHBRUSH BATT")
' This is the cell Address (in case it keeps looping back to beginning)
Dim addy as string
if not find is nothing then addy = find.address
' If we've found a cell then Keep Do something with it
Do while not find is nothing
find.Value = "BATTERY"
' Find the next Cell
set find = Range("A:A").Cells.Find(What:="TOOTHBRUSH BATT", After:= find)
' If the next found cell is the first one then exit sub/function
if find.address = addy then exit sub
Loop

Solving variable variable's names issue in excel

I have a programming issue concerning variable variable's names
I need to make an questionaire in excel where answers to certain questions will either hide or unhide certain rows. I have no idea how to optimize it, although I searched for the solution for quite a while.
Code sample which performs an action on one question
Private Function RowNo(ByVal text1 As String) As Long
Dim f As Range
Set f = Columns(2).Find(text1, Lookat:=xlWhole)
If Not f Is Nothing Then
RowNo = f.Row
Else
RowNo = 0
End If
End Function
Dim QAr As Variant
Dim YtQ1Ar As Variant
Dim YtQ1, rYtQ1 As Long
QAr = Array("Q1")
YtQ1Ar = Array("1.2", "1.3", "1.4", "1.5", "1.6", "1.7", "1.7.1", "1.7.2", "1.7.23", "1.7.24", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13")
For Q = LBound(QAr) To UBound(QAr)
For YtQ1 = LBound(YtQ1Ar) To UBound(YtQ1Ar)
rYtQ1 = RowNo(YtQ1Ar(YtQ1))
If rYtQ1 > 0 Then
Rows(rYtQ1).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK")
Else
Debug.Print "'" & YtQ1Ar(YtQ1) & "' was not found!"
End If
Next YtQ1
Next Q
Now, I want to perform similar actions on many different questions.
At first I wanted to create a similar arrays and variables with names
Q1, YtQ1Ar;
Q2, YtQ2Ar
... and so on, but I found out that it is impossible to use a variable variable's names in a loop in VBA.
Can you please help me with an idea how to solve that issue? Or do I have to rewrite the code for each question?
There are several ways of creating 'lists' of variables. Three of the most common are:
Collections, exactly as MacroMan's code - take note of how he declares his variables (use a datatype for each declaration).
Multi-dimensional arrays, you can reference each of the indexes independently. This probably wouldn't suit you as the number of sub-questions might vary for each question but, nevertheless, a snippet of your code might be:
Dim questions(10, 20) As Variant 'where first dimension is question number and second is sub-question item.
questions(0,0)="1.1"
questions(0,1)="1.2"
' etc.
Array of Arrays, you can keep a one-dimensional array for each of your sub-question arrays. This might be more suitable to you, like so:
Dim questions(10) As Variant
questions(0) = Array("1.2", "1.3", "1.4", "1.5") 'etc.
questions(1) = Array("2.2", "2.4", "2.6") 'etc.
Having said that, your code is a touch inefficient because it runs the .Find routine in every iteration of your loop and it will throw an unhandled error if any of the sub-question items don't exist in line: Rows(rYtQ).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK").
Architecturally, you'd be far better to read all of the relevant rows into some kind of storage (say a Range or Collection) in one routine, and in a second routine, check each question to see if those rows need to be hidden. This will give you greater speed and much more flexibility (e.g. to toggle the hidden/unhidden whenever an answer is changed). Sorry it's such a lengthy answer, but it gives you an idea of how important a planned programme structure is.
In the code below, I've given you an example of this. I've used a Class object to make it more obvious (this might be a bit black belt VBA so you may want to ignore it, but it does make the point clearly). So...
First insert a Class Module (Insert ~> Class Module) and name it cQuestionFields. Then paste this code into it:
Option Explicit
Private mQuestionNumber As Integer
Private mAnswerCell As Range
Private mQuestionRange As Range
Private mUnHiddenKey As String
Private mHideUnhideRows As Range
Public Property Get QuestionNumber() As Integer
QuestionNumber = mQuestionNumber
End Property
Public Function AnswerIsChanged(cell As Range) As Boolean
AnswerIsChanged = Not Intersect(cell, mAnswerCell) Is Nothing
End Function
Public Sub HideOrUnhideRows()
Dim answer As String
answer = UCase(CStr(mAnswerCell.Value2))
mHideUnhideRows.EntireRow.Hidden = (answer <> mUnHiddenKey)
End Sub
Public Function InitialiseQuestion(questionNum As Integer, _
questionColumn As Range, _
answerColumn As Range, _
unhideKey As String) As Boolean
Dim ws As Worksheet
Dim thisQ As String
Dim nextQ As String
Dim startCell As Range
Dim endCell As Range
Dim offsetQtoA As Integer
'Assign the question number
mQuestionNumber = questionNum
'Assign column offset between question and answer
offsetQtoA = answerColumn.Cells(1).Column - _
questionColumn.Cells(1).Column
'Convert question number to string format "n."
thisQ = CStr(questionNum) & "."
nextQ = CStr(questionNum + 1) & "."
'Find cell of this question
Set ws = questionColumn.Worksheet
Set startCell = questionColumn.Cells.Find( _
What:=thisQ, _
After:=questionColumn.Cells(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'Check the question exists
If startCell Is Nothing Then
InitialiseQuestion = False
Exit Function
End If
'Set the answer cell
Set mAnswerCell = startCell.Offset(, offsetQtoA)
'Find the last cell within this question range
Set endCell = questionColumn.Cells.Find( _
What:=nextQ, _
After:=startCell, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'If nothing is found, set end of column
If endCell Is Nothing Then
Set endCell = ws.Cells(ws.Rows.Count, questionColumn.Column).End(xlUp)
Else
Set endCell = endCell.Offset(-1)
End If
'Define the search range for this question
Set mQuestionRange = ws.Range(startCell, endCell)
'Assign the hiding key
mUnHiddenKey = unhideKey
InitialiseQuestion = True
End Function
Public Sub AssignTargetRows(ParamArray questions() As Variant)
Dim questionItem As Variant
Dim lastCell As Range
Dim foundCell As Range
'Find the relevant cells for each question item
Set lastCell = mQuestionRange.Cells(1)
For Each questionItem In questions
Set foundCell = mQuestionRange.Cells.Find( _
What:=CStr(questionItem), _
After:=lastCell, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'If the question item exists, add it to our range
If Not foundCell Is Nothing Then
If mHideUnhideRows Is Nothing Then
Set mHideUnhideRows = foundCell
Else
Set mHideUnhideRows = Union(mHideUnhideRows, foundCell)
End If
Set lastCell = foundCell
End If
Next
End Sub
Now in your module, paste the calling codes:
Option Explicit
Private mQuestionBank As Collection
Public Sub Main()
Dim q As cQuestionFields
'Assign all your values for each question
PopulateQuestionBank
'Loop through each question to test for hiding
For Each q In mQuestionBank
q.HideOrUnhideRows
Next
End Sub
Public Sub ActIfAnswerChanged(Target As Range)
Dim cell As Range
Dim q As cQuestionFields
' Loop through cells in target to see if they are answer cells
For Each cell In Target.Cells
For Each q In mQuestionBank
If q.AnswerIsChanged(cell) Then q.HideOrUnhideRows
Next
Next
End Sub
Public Sub PopulateQuestionBank()
Dim ws As Worksheet
Dim q As cQuestionFields
Dim validQ As Boolean
Set mQuestionBank = New Collection
'Assign the worksheet holding the question.
'You can change this whenever any of your question are on a different sheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Question 1: note change question and answer columns to yours.
Set q = New cQuestionFields
validQ = q.InitialiseQuestion(questionNum:=1, _
questionColumn:=ws.Columns(2), _
answerColumn:=ws.Columns(4), _
unhideKey:="TAK")
If validQ Then
q.AssignTargetRows "1.2", "1.3", "1.4", "1.5", "1.6", "1.7", "1.7.1", "1.7.2", "1.7.23", "1.7.24", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13"
mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
End If
'Question 2
Set q = New cQuestionFields
validQ = q.InitialiseQuestion(questionNum:=2, _
questionColumn:=ws.Columns(2), _
answerColumn:=ws.Columns(4), _
unhideKey:="TAK")
If validQ Then
q.AssignTargetRows "2.2", "2.3", "2.4", "2.5", "2.6"
mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
End If
'Question 3
Set q = New cQuestionFields
validQ = q.InitialiseQuestion(questionNum:=3, _
questionColumn:=ws.Columns(2), _
answerColumn:=ws.Columns(4), _
unhideKey:="TAK")
If validQ Then
q.AssignTargetRows "3.7", "3.7.3", "3.7.2", "3.7.23", "3.7.24"
mQuestionBank.Add q, Key:=CStr(q.QuestionNumber)
End If
End Sub
You'll see that I've added a routine called ActIfAnswerChanged. This is what I mean by added flexibility. If you post the following code in your Worksheet_Change event (double click your question sheet in your VBA editor and select this event), then it will run hide/unhide the rows whenever an answer is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
ActIfAnswerChanged Target
End Sub
Try something like:
Dim QColl As Collection
Dim Q As Long
Dim YtQAr As Variant
Dim YtQ As Long, rYtQ As Long
Set QColl = New Collection
QColl.Add Array("1.2", "1.3", "1.4", "1.5"), Key:="Q1"
QColl.Add Array("2.2", "2.3"), Key:="Q2"
For Q = 1 To QColl.Count
YtQAr = QColl.Item("Q" & Q)
For YtQ = LBound(YtQAr) To UBound(YtQAr)
rYtQ = RowNo(YtQAr(YtQ))
If rYtQ > 0 Then
Rows(rYtQ).Hidden = (UCase(Cells(RowNo("1."), ColAn).Value) <> "TAK")
Else
Debug.Print "'" & YtQAr(YtQ) & "' was not found!"
End If
Next YtQ
Next Q

How to find text in a column and saving the row number where it is first found - Excel VBA

I have the following column (column A) named project (rows column is just displaying the row number):
rows project
1 14
2 15
3 16
4 17
5 18
6 19
7 ProjTemp
8 ProjTemp
9 ProjTemp
I have an input message box where the user writes the new project name which I want inserted right after the last one. Ex: project 20 will be inserted right after project 19 and before the first "ProjTemp".
My theory was to locate the row number of the first "ProjTemp" and then insert a new row where the project is 20.
I was trying to use the Find function but I'm getting an overflow error (I'm sure I'm getting it because it's finding 3 "ProjTemp" strings and trying to set it to one parameter):
Dim FindRow as Range
with WB.Sheets("ECM Overview")
Set FindRow = .Range("A:A").Find(What:="ProjTemp", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
MatchCase:=False)
end with
How do I code this so I only find the row number of the fist "ProjTemp"?
Is there a better way to do this, maybe a loop?
Thanks, any help will be appreciated!
I'm not really familiar with all those parameters of the Find method; but upon shortening it, the following is working for me:
With WB.Sheets("ECM Overview")
Set FindRow = .Range("A:A").Find(What:="ProjTemp", LookIn:=xlValues)
End With
And if you solely need the row number, you can use this after:
Dim FindRowNumber As Long
.....
FindRowNumber = FindRow.Row
Dim FindRow as Range
Set FindRow = Range("A:A").Find(What:="ProjTemp", _' This is what you are searching for
After:=.Cells(.Cells.Count), _ ' This is saying after the last cell in the_
' column i.e. the first
LookIn:=xlValues, _ ' this says look in the values of the cell not the formula
LookAt:=xlWhole, _ ' This look s for EXACT ENTIRE MATCH
SearchOrder:=xlByRows, _ 'This look down the column row by row
'Larger Ranges with multiple columns can be set to
' look column by column then down
MatchCase:=False) ' this says that the search is not case sensitive
If Not FindRow Is Nothing Then ' if findrow is something (Prevents Errors)
FirstRow = FindRow.Row ' set FirstRow to the first time a match is found
End If
If you would like to get addition ones you can use:
Do Until FindRow Is Nothing
Set FindRow = Range("A:A").FindNext(after:=FindRow)
If FindRow.row = FirstRow Then
Exit Do
Else ' Do what you'd like with the additional rows here.
End If
Loop
Alternatively you could use a loop, keep the row number (counter should be the row number) and stop the loop when you find the first "ProjTemp".
Then it should look something like this:
Sub find()
Dim i As Integer
Dim firstTime As Integer
Dim bNotFound As Boolean
i = 1
bNotFound = True
Do While bNotFound
If Cells(i, 2).Value = "ProjTemp" Then
firstTime = i
bNotFound = false
End If
i = i + 1
Loop
End Sub
A few comments:
Since the search position is important you should specify where you start the search. I use ws.[a1] and xlNext below so my search starts in A2 of the specified sheet.
Some of Finds arguments - including lookat use the prior search settings. So you should always specify xlWhole or xlPart to match all or part a string respectively.
You can do all you want - including inserting a row, and prompting the user for a new value (my code will suggest 20 if the prior value was 19) without using Select or Activate
suggested code
Sub FindEm()
Dim Wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Set Wb = ThisWorkbook
Set ws = Wb.Sheets("ECM Overview")
Set rng1 = ws.Range("A:A").Find("ProjTemp", ws.[a1], xlValues, xlWhole, , xlNext)
If Not rng1 Is Nothing Then
rng1.EntireRow.Insert
rng1.Offset(-1, 0).Value = Application.InputBox("Please enter data", "User Data Entry", rng1.Offset(-2, 0) + 1, , , , , 1)
Else
MsgBox "ProjTemp not found", vbCritical
End If
End Sub
Check for "projtemp" and then check if the previous one is a number entry (like 19,18..etc..) if that is so then get the row no of that proj temp ....
and if that is not so ..then re-check that the previous entry is projtemp or a number entry ...

Resources