VBA Copy Paste formula search - vba

Code below taken from a previous question asked
My Question - How do i get this to work if the find and search values are formulas? ..I've tried changing the .Value2 but doesn't seem to work.
VBA Copy Paste string search
With Sheets("SheetName") ' Change to your actual sheet name
Dim r As Range: Set r = .Range("C10:G10").Find(.Range("A10").Value2, , , xlWhole)
If Not r Is Nothing Then r.Offset(4, 0).Resize(5).Value2 = .Range("A14:A18").Value2
End With

If you're looking for the results of formulas, you need to specify xlValues for the LookIn parameter. When it's blank it defaults to xlFormulas. For example, to find any formula that results in "Bar" (i.e. =CONCATENATE("B","a","r")) on Sheet "foo", you would do this:
With ActiveWorkbook.Sheets("Foo")
Dim r As Range
Set r = .UsedRange.Find("Bar", , xlValues, xlWhole)
If Not r Is Nothing Then
Debug.Print r.Address
End If
End With
If you want to find a sheet that contains the actual formula you can either leave out the LookIn parameter entirely or explicitly specify it:
With ActiveWorkbook.Sheets("Foo")
Dim r As Range
Set r = .UsedRange.Find("=CONCATENATE(""B"",""a"",""r"")", , _
xlFormulas, xlWhole)
If Not r Is Nothing Then
Debug.Print r.Address
End If
End With

Related

Condensing Code with For Loop?

So I am creating a module to find a text string in a sheet to print into another sheet, the code works But it feels cumbersome, i have to run the code multiple times to get the results I want, i know a For statement is how i should be going about it but I just wanted to check. This is the current code
Sub FindRANumbers()
Dim RA1Range As Range
emptyRow = WorksheetFunction.CountA(Sheet3.Range("A:A")) + 1
Sheet2emptyRow = WorksheetFunction.CountA(Sheet2.Range("H:H"))
'Find Checkbox values and paste them into Sheet 3
Set RA1Range = Sheet2.Cells.Find("RA0001")
Set RA1Check = Sheet3.Cells.Find("RA0001")
If Not RA1Check Is Nothing Then
ElseIf Not RA1Range Is Nothing Then
Sheet3.Cells(emptyRow, 1).MergeArea.Value = "RA0001"
End If
End Sub
It needs to loop through as many rows as are in Sheet2 H:H.
I am not very well versed in For loops but when I this, I still need to run the code multiple times
For i = 1 To Sheet2emptyrow
'Above code here'
Next i
I feel like i am missing something quite simple
Thank you in advance for any help.
EDIT:
I think my description of the problem is a little poor so I have attached an Image to show what i am trying to do
So I want to loop through as many cells that are filled here in Sheet 2 and run my code for each loop
I hope that makes more sense? Sorry about this, But thank you for your help
Using the example of Range.Find Method (Excel) this code finds with a For Loop.
However, remember that if you are working with a large Workbook, it is not the fastest way of searching. Here is a performance test
And do you really have to search on the entire Sheet3? Because it makes it really sloooow. Assuming Sheet2 Column H are the reference values, so you search it on the entire Sheet3.
lastrow = Sheet2.Cells(Sheet2.Rows.Count, "H").End(xlUp).Row
For I = 8 To lastrow
Set c = Sheet2.Cells(I, 8)
With Sheet3
Set cellFound = .Find(what:=c, LookIn:=xlValues, MatchCase:=False)
If Not cellFound Is Nothing Then
FirstAddress = cellFound.Address
Do
'When value is found do something here
Debug.Print cellFound.Address 'To print the addresses of cells found
Set cellFound = .FindNext(cellFound)
Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress
End If
End With
Next I
Exaplaining the code
LastRow of Column H
lastrow = Sheet2.Cells(Sheet2.Rows.Count, "H").End(xlUp).Row
For loop from line 8 to lastrow of column H of Sheet2
For I = 8 To lastrow
Next I
The value to search, so using the variable I to loop through all rows
Set c = Sheet2.Cells(I, 8)
Range of search
With Sheet3
End With
Find, using the example of .Find Method
Set cellFound = .Find(what:=c, LookIn:=xlValues, MatchCase:=False)
If Not cellFound Is Nothing Then
FirstAddress = cellFound.Address
Do
'When value is found do something here
Debug.Print cellFound.Address 'To print the addresses of cells found
Set cellFound = .FindNext(cellFound)
Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress
End If

Infinite loop with .Find method

I am trying to write a VBA script to automate moving things around in an spreadsheet that has a balance sheet imported from an accounting software.
The values on imported balance sheet start at row 5, column A has some text describing what the values of each row mean, and columns B and D have the amounts for each item.
The subtotals for each section and subsection of the balance sheet are on columns C and E. Each subtotal has is in a cell formatted with a solid upper border.
I would like to bring all these subtotals to the same columns as the values (i.e, columns B and D). I've tried to do this using the .Find method to search for cells with the specific format (cells with an upper border) and a Do loop to keep searching until I find all cells that should have a subtotal in it.
Notes:
I didn't use FindNext because it seems that it ignores format settings used in the preceding Find method, as described here.
I tried to used the FindAll function described by Tushar Mehta to go around this problem with FindNext, but it didn't find all cells with the specified format.
Here's the code. Any help is greatly appreciated!
Sub FixBalanceSheet()
Dim LookFor As Range
Dim FoundHere As String 'Address of the cell that should contain a subtotal
Dim beginAt As Range, endAt As Range, rng As Range 'Set the ranges for the sum to get the subtotal
Dim place As String 'String with the address of a cell that will contain a subtotal
Dim WhereToLook As Range 'Range where subtotals are to be found
'Set workbook and worksheet
With Sheets("Sheet1")
Set WhereToLook = Range("A5:F100")
'Every cell containing a subtotal has an upper border. So, look for cells containing border!
With Application.FindFormat.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
'Call search using .Find
Set LookFor = WhereToLook.Find(What:="", After:=Cells(5, 2), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
If Not LookFor Is Nothing Then 'Test if a cell with a bottom border is found
'What happens when a subtotal cell is found:
FoundHere = LookFor.Address
Debug.Print "Found at: " & Found
'Loop to set a range, sum values and put them in the right cell
Do
'% find out a range to calculate subtotals and put the value in the right cells %'
'Call for next search
With Application.FindFormat.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Set LookFor = WhereToLook.Find(What:="", After:=endAt, SearchFormat:=True)
Debug.Print "LookFor now is: " & LookFor.Address
Rem If LookFor.Address = Found Then ' Do not allow wrapped search
Rem Exit Do
Rem End If
Loop Until LookFor Is Nothing Or LookFor.Address = FoundHere ' Do not allow wrapped search
End If
End With
End Sub
Consider using a range object to loop through your range. You can add a total if you need a grand total, but this is probably an easier way than trying to select all cells that have formatting.
For example:
Sub TestStackOverflowCode()
Dim r As Range
Dim rngToChk As Range
'This is where you'd insert WhereToLook
Set rngToChk = ActiveSheet.Range("B1:B4")
For Each r In rngToChk
'If the top edge does not NOT have a border
If r.Borders(xlEdgeTop).LineStyle <> xlNone Then
'Copy the cell value to two cells to the right
r.Offset(, 2).Value = r.Value
End If
Next r
End Sub
I would recommend going back to the Range.Find/Range.FindNext method. There were some holes in your logic conditions and I believe I've adjusted them.
Set LookFor = WhereToLook.Find(What:="", After:=Cells(5, 2), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
If Not LookFor Is Nothing Then 'Test if a cell with a bottom border is found
'What happens when a subtotal cell is found:
FoundHere = LookFor.Address
Debug.Print "Found at: " & FoundHere
'Loop to set a range, sum values and put them in the right cell
Do
'do something with LookFor as a Range Object here
'Call for next search
Set LookFor = WhereToLook.FindNext(After:=LookFor) '<~~ look for next after current cell
Debug.Print "LookFor now is: " & LookFor.Address
Loop Until LookFor.Address = FoundHere ' Do not allow wrapped search (LookFor will never be nothing here)
End If
The findNext may not have worked if
you had [FindFormat.Borders...] after the [Set LookFor = WhereToLook.Find(...]
I do think ThreeTrickPony's answer is more elegant, but in general I'd suggest finding an alternative way to identify cells rather than formatting.

Find value in many tables, then act on first blank row within matched table

Background: I am writing a macro that copies information from a change log into the matched row within a master file made of several sheets which each contain one table. I have the changes written and working, but need to also include a procedure for when the change request is to add a new row. I have a list in Col A that matches with the request, so I need to search for a matched Col A value within the file, then go to the first blank row in the table (there is a lot of empty space still held within the tables), then copy over the relevant information.
Function AddMatch(LOBID As String) As Range
Dim arrSheets, s As Worksheet, f As Range
Dim addr1 As String
arrSheets = Array("Sheet names all go here")
For Each s In arrSheets
Set s = ActiveWorkbook.Sheets(s)
Set f = s.Columns("A").Find(LOBID, Cells(Rows.Count, "A"), xlValues, xlWhole)
If Not f Is Nothing Then
addr1 = f.Address()
Do
Set AddMatch = f.EntireRow
Exit Function
Set f = s.Columns("A").Find(LOBID, f, xlValues, xlWhole)
Loop While f.Address() <> addr1
End If
Next s
Set AddMatch = Nothing
End Function
I have this function which finds me the row within the sheets where LOBID is a match. It may be overcomplicated, but I used the same function with two criteria for another action so it was an easy copy-paste. I need to act upon the first blank row within the table where that match was found, which is where I'll be adding the new information (copied from the change log).
This returns the first row with a match in Col A.
Set destRNG = AddMatch(CStr(changeWS.Cells(i, "A")))
I have a feeling there's a very simple addition to get me from this row to the first blank within the table, but I keep getting a Method 'Range' of object'_Global' error on just about everything I've tried. Is there a simpler way to do this? Thank you in advance for your help.
FOLLOW-UP: Trying to copy a range from the change log to the new row. This throws a Method 'Range' of object'_Global' error, not sure how to adjust it to work.
rw.Range(Cells(1, 1), Cells(1, 10)) = changeWS.Range(Cells(i, 1), Cells(i, 10))
Something like this:
Sub Tester()
Dim rw As Range
Set rw = FirstEmptyRow("AAA")
If Not rw Is Nothing Then
Debug.Print "Found empty row on " & rw.Parent.Name, rw.Address()
Else
Debug.Print "Not found..."
End If
End Sub
Function FirstEmptyRow(LOBID As String) As Range
Dim arrSheets, s, rv As Range
arrSheets = Array("Sheet1", "Sheet2", "Sheet3")
For Each s In arrSheets
Set s = ActiveWorkbook.Sheets(s)
'any match on this sheet?
If Not IsError(Application.Match(LOBID, s.Columns("A"), 0)) Then
Set rv = s.Rows(2) 'start here and work down...
Do While Application.CountA(rv) > 0
Set rv = rv.Offset(1, 0)
Loop
Exit For
End If
Next s
Set FirstEmptyRow = rv
End Function
EDIT:
rw.Range(Cells(1, 1), Cells(1, 10)) = changeWS.Range(Cells(i, 1), Cells(i, 10))
Here you have a problem because Cells() without a worksheet qualifier always points to the ActiveSheet, so you're essentially trying to create a range across multiple sheets, hence the error.
rw.Range(rw.Cells(1, 1), rw.Cells(1, 10)).Value = _
changeWS.Range(changeWS.Cells(i, 1), changeWS.Cells(i, 10)).Value
would be more correct, but I would prefer this type of approach:
rw.Cells(1, 1).Resize(1, 10).Value = changeWS.Cells(i, 1).resize(i, 10).Value

Excel VBA with single search criteria, loop for all distinct values

I am getting this error message when I run the macro:
Run-time error '6': Overflow
I have two worksheets; Search and Data. The 'Data' worksheet contains two columns, column A with numbers I want to search through and column B with an alphanumeric value I want to copy and paste into the 'Search' worksheet when a number match is found. Because a number I am searching for can be listed an unknown number of times I want a macro to loop through to find all of the instances, copy the value to its immediate right and paste it into the 'Search' worksheet in cell D3 and going down a row for multiple instances of the number being found.
The number I am searching for is found in cell B3 on the 'Search' worksheet.
This is a sample of what the 'Data' worksheet looks like:
ID ISS_ID
108143 136KQV4
108143 173HBK3
108143 136KQX0
109728 7805JM1
109706 7805JM1
102791 23252T4
105312 6477LZ6
Here is the code that I have now:
Sub Acct_Search()
Dim searchResult As Range
Dim x As Integer
x = 3
' Search for "Activity" and store in Range
Set searchResult = Worksheets("Data").Range("A1:A3500").Find(What:=Worksheets("Search").Range("B3"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
' Store the address of the first occurrence of this word
firstAddress = searchResult.Address
Do
' Set the value in the O column, using the row number and column number
Worksheets("Search").Cells(x, 4) = searchResult.Offset(0, 1).Value
' Increase the counter to go to the next row
x = x + 1
' Find the next occurrence of "Activity"
Set searchResult = Cells.FindNext(searchResult)
' Check if a value was found and that it is not the first value found
Loop While Not searchResult Is Nothing And firstAddress <> searchResult.Address
End Sub
When I Debug it points to the x = x + 1 line. Right now it is able to copy and paste the first value without issue but it is after that point that the error comes into play.
Your problem changed because you are not resetting the origin point of the search with the After:=... parameter of the Range.FindNext Method. Yes, you are passing in searchResult but it was not accepting it as the After:= parameter.
When I ran your code, I was thrown into an infinite loop due to the FindNext always finding the same second instance. This explains the integer coughing at being incremented above 2¹⁵. When it was changed to a long, that gave something else time to choke.
After I changed one line to definitively include the named parameter, everything cleared up.
Set searchResult = Cells.FindNext(After:=searchResult)
This was reproducible simply by adding/removing the parameter designation. It seems that the Cells.FindNext(searchResult) was finding Search!B3 and since that wasn't the firstAddress, it just kept looping on the same Search!B3. It wasn't until I forced after:=searchResult that the .FindNext adjusted itself. It's times like these I think fondly of my C/C++ days without this wallowing overhead.
I've gone through your code and added a With ... End With block that should discourage any questionable parentage.
Sub Acct_Search()
Dim searchResult As Range, firstAddress As String
Dim x As Long, ws As Worksheet
x = 3
Set ws = Worksheets("Search")
' Search for "Activity" and store in Range
With Worksheets("Data").Range("A1:A3500")
Set searchResult = .Find(What:=ws.Range("B3"), LookIn:=xlFormulas, After:=.Cells(.Rows.Count, .Columns.Count), _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
' Store the address of the first occurrence of this word
firstAddress = searchResult.Address
Do
' Set the value in the O column, using the row number and column number
ws.Cells(x, 4) = searchResult.Offset(0, 1).Value
' Increase the counter to go to the next row
x = x + 1
' Find the next occurrence of "Activity"
Set searchResult = .FindNext(After:=searchResult)
'Debug.Print searchResult.Address(0, 0, external:=True)
' Check if a value was found and that it is not the first value found
Loop While Not searchResult Is Nothing And firstAddress <> searchResult.Address
End With
Set ws = Nothing
End Sub
I've left the After:= parameter designation in although it is no longer needed.
Change
Dim x As Integer
to
Dim x As Long

Type Mismatch Run Time error 13 for excel VBA

I have requirement to write some function which will accept Range as input and I need to return value of first non empty cell. I have tried in one excel sheet and finding non empty cell was working fine. When I try with my project excel file it was not working. Basically for Find method of Range I am getting runtime error 13. Check below code and let me know what is the issue. I have noticed even in when I put Range.Row property it make "Row" as row in code ( in below code see Target.row).
Sub Btn_GenerateChartClicked()
If Range("E9") = "Scatter" Then
MsgBox "Scatter is selected"
Dim str As String
Dim rng As Range
Set rng = Range("B12:I12")
str = FindNonEmptyCellFromRange(rng)
' MsgBox str
Else
MsgBox "Bar is selected"
End If
End Sub
Function FindNonEmptyCellFromRange(Target As Range) As String
Dim ws As Worksheet
Set ws = Sheets("Benchmarking_Project")
Dim foundRange As Range
Set foundRange = Target.Find("*", Cells(Target.row, 1), xlFormulas, , xlByColumns, xlPrevious)
'Dim cellValue As String
'cellValue = foundRange.Value
FindNonEmptyCellFromRange = "Test"
'cellValue
End Function
You can't find a target.
use Cell.Find and then once you have the cell selected use Target.Address to get the address of the cell
So your CellValue would become:
CellValue = FoundRange.Address
Although, your question is a little vague as your not doing anything practicle with this UDF anyway
Your question does not provide enough details and the function call does not return the non empty cell. Whatever happens your function will return only Test.
Anyway when going through the code, your range has a single row in it.
Issue seems to be with the following code
Set foundRange = Target.Find("*", Cells(Target.row, 1), xlFormulas, , xlByColumns, xlPrevious)
There is no need to specify the After Parameter Cells(Target.row, 1)
After parameters corresponds to the position of the active cell when a search is done from the user interface. Notice that After must be a single cell in the range. Remember that the search begins after this cell; the specified cell isn’t searched until the method wraps back around to this cell. If you do no specify this argument, the search starts after the cell in the upper-left corner of the range.
Try to change that code to
Set foundRange = Target.Find("*", , xlFormulas, , xlByColumns, xlPrevious)
The following code may work for you
Sub Btn_GenerateChartClicked()
If Range("E9") = "Scatter" Then
MsgBox "Scatter is selected"
Dim str As String
Dim rng As Range
Set rng = Range("B12:I12")
str = GetFirstNonEmptyCell(rng)
' MsgBox str
Else
MsgBox "Bar is selected"
End If
End Sub
Public Function GetFirstNonEmptyCell(Target As Range)
Dim startCell As Range, firstNonEmptyCell As Range
For Each c In Target.Cells
If Trim(c.Value) <> "" Then
Found_Address = c.Address
Exit For
End If
Next
GetFirstNonEmptyCell = Found_Address
End Function
Ian your suggestion about not to use Cells(Target.Row,1) in Find method is right. I got my mistake. In that I have put column index as 1 but it should be 2 because my selected range is from Column B which means column index 2. So I got actually error because there is no column index 1 in that range. So if I put 2 instead of 1 in above mentioned call then it is working fine. Yes your right that I was not returning actually value of last non empty cell as that was my R&D code I kept changing it. So while posting it I forgot to change it. Thank you all for your reply