I need a way in excel to go through my entire workbook and find all the words with a matching case and add them into italics.
I have cells with data like so:
Percentage of CTE concentrators who have met the proficient or advanced level on the
statewide high school mathematics assessment administered by the state under ESEA and
who, in the reporting year, left secondary education.
I need to change all the "ESEA" into italics.
Is there a way to do this in excel or do I need a macro?
Here's code that will do this for you:
Sub Macro1()
Dim sFirstAddress As String, rgFound As Range
Const sSearch As String = "ESEA"
Set rgFound = Cells(1, 1)
Do While Not rgFound Is Nothing
Set rgFound = Cells.Find(What:=sSearch, After:=rgFound, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, _
SearchFormat:=False)
If rgFound.Address = sFirstAddress Then Exit Do
If InStr(rgFound.Value, sSearch) > 0 Then
If Len(sFirstAddress) = 0 Then sFirstAddress = rgFound.Address
rgFound.Characters(InStr(rgFound.Value, sSearch), Len(sSearch)).Font.FontStyle = "Italic"
End If
Loop
End Sub
Related
On an excel sheet, there are some continuous ranges with the same color in a row. The problem is to find all these continuous ranges not as individual cells but as a set of continuous ranges.
Tried cell.displayformat.interior.color but getting continuous ranges is the problem.
For the below image, we need to get the 3 continuous ranges with the same color.
You could use the Union function to do the heavy lifting - it automatically creates the areas as you add cells to it. So you could iterate a Find, looking for the cell colour, and add it to a found collection of cells with Union.
In your example, this would give you three areas. Skeleton code would be:
Dim cell As Range, foundRange As Range, colouredArea As Range
Dim firstAddr As String
With Application.FindFormat
.Clear
.Interior.Color = 10921638
End With
Set cell = Sheet1.Range("A1")
Do While True
Set cell = Sheet1.Cells.Find( _
What:="", _
After:=cell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
If cell Is Nothing Then Exit Do
If cell.Address = firstAddr Then Exit Do
If firstAddr = "" Then firstAddr = cell.Address
If foundRange Is Nothing Then
Set foundRange = cell
Else
Set foundRange = Union(foundRange, cell)
End If
Loop
If Not foundRange Is Nothing Then
For Each colouredArea In foundRange.Areas
Debug.Print colouredArea.Address
Next
End If
This is part of a bigger code that both filters based on input text and then creates subtotals out of the values associated with warranty subtypes, this is applied to several different sheets and it all works.
There is the possibility of many different Warranties subtypes.
I check for each one individually, first for an exact match case for "WarrantyPrefA Total" (this should be on the AJ Column).
If it exists, I want to store that range value inside a variable(GaRangeID), so I can apply an offset of that range to grab the two numerical values present in other columns and paste it on another Workbook.
If it doesn't exist, I want to terminate that find, and find another exact match case.
My guess is I'm messing up the .Find inner syntax to search the correct range.
Dim GaRangeID As Range
Dim WBModeloA1 As Worksheet
Dim WBModeloA2 As Worksheet
Set WBModeloA1 = Workbooks("ModeloAnalisis.xlsm").Sheets("Cartera 1")
Set WBModeloA2 = Workbooks("ModeloAnalisis.xlsm").Sheets("Cartera 3")
'GPB
Dim strSearch As String
Dim lastrow As Long
strSearch = "WarrantyPrefA Total"
lastrow = WBevoDeuM.Range("AJ" & Rows.Count).End(xlUp).Row
Set GaRangeID = WBevoDeuM.Range("AJ1", "AJ" & lastrow).Find(What:=strSearch, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not GaRangeID Is Nothing Then
WBModeloA1.Range("E67") = GaRangeID.Offset(0, -3).Range("A1")
WBModeloA1.Range("E67").Value = WBModeloA1.Range("E67").Value / 1000
WBModeloA2.Range("H91") = GaRangeID.Offset(0, -21).Range("A1")
WBModeloA2.Range("H91").Value = WBModeloA2.Range("H91").Value / 1000
Else
End If
'GPA
Set GaRangeID = Cells.Find(What:="WarrantyPrefB Total", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not GaRangeID Is Nothing Then
WBModeloA1.Range("E65") = GaRangeID.Offset(0, -3).Range("A1")
WBModeloA1.Range("E65").Value = WBModeloA1.Range("E65").Value / 1000
WBModeloA2.Range("H90") = GaRangeID.Offset(0, -21).Range("A1")
WBModeloA2.Range("H90").Value = WBModeloA2.Range("H90").Value / 1000
Else
End If
The reason I show it repeats the same structure but with another find afterwards is because I used to have the "find" part defined in another way.
The following way properly pastes the subtotals onto the other workbook, but I discarded it since it always sets the GaRangeID as the active cell, when the search gets nothing, the active cell remains as the old subtotal found, and so it just pastes the values of WarrantyA onto B.
Cells.Find(What:="WarrantyPrefB Total", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Set GaRangeID = ActiveCell
I don't have much to offer except to simplify your code a bit and use xlValues instead of xlFormulas for the LookIn parameter
Sub Tester()
Dim f As Range
Dim WBModeloA1 As Worksheet
Dim WBModeloA2 As Worksheet
Dim wsData As Worksheet, rngSearch As Range
'use "ThisWorkbook" if it's where your code lives
Set WBModeloA1 = ThisWorkbook.Sheets("Cartera 1")
Set WBModeloA2 = ThisWorkbook.Sheets("Cartera 3")
Set wsData = ThisWorkbook.Sheets("Data") 'the sheet you're searching
'define a range to search
Set rngSearch = wsData.Range(wsData.Range("AJ1"), _
wsData.Cells(Rows.Count, "AJ").End(xlUp))
'if you have multiple of these following blocks you really need a loop
Set f = rngSearch.Find(what:="WarrantyPrefA Total", LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False)
If Not f Is Nothing Then
WBModeloA1.Range("E67") = f.Offset(0, -3).Value / 1000
WBModeloA2.Range("H91") = f.Offset(0, -21).Value / 1000
End If
Set f = rngSearch.Find(what:="WarrantyPrefB Total", LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False)
If Not f Is Nothing Then
WBModeloA1.Range("E65") = f.Offset(0, -3).Value / 1000
WBModeloA2.Range("H90") = f.Offset(0, -21).Value / 1000
End If
End Sub
Friends, Good day! For the last week I have been trying every imaginable way of trying to solve the issue I am having. Here is my code:
Sub LoopTest()
Dim Current As Worksheet
Dim range3 As Range
Workbooks("Book2.xlsm").Activate
For Each Current In ActiveWorkbook.Worksheets
Set range3 = Cells.Find(What:="AAIDL00", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not range3 Is Nothing Then
Debug.Print range3.Value
Exit For
Else: Debug.Print "Search term not found!"
End If
Next
End Sub
I am looking for "AAIDL00" in a test workbook with 8 sheets. This string is located on sheet8 cell R22. The script work when I manually select (click on) sheet8 on the workbook. But, when I have any other sheet selected, the script returns "Search term not found!".
Can somebody please help me with this? I have been all over the forums and seem the code is more or less "standard" in structure. I don't understand why I am getting this error. Something tells me this is a global setting issue with my PC or maybe even the excel installation. Not sure. Any ideas are appreciated!
Use one or more With ... End With blocks to provide definitive parent worksheet and workbook references.
Sub LoopTest()
Dim w As Long, range3 As Range
With Workbooks("Book2.xlsm")
For w = 1 To .Worksheets.Count
With .Worksheets(w)
Set range3 = .Cells.Find(What:="AAIDL00", After:=.Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not range3 Is Nothing Then
Debug.Print range3.Value
Exit For
Else
Debug.Print "Search term not found in " & .Name
End If
End With
Next w
End With
End Sub
Note the . prefix on worksheets, cells and range. This provides parentage from the immediately preceding With ... End With block.
I have a excel file with a schedule of date wise samples up to 3 years.
In that sheet how to find a today samples as a popup alert in VBA
Please help me.
So far as i think, this might ful-fill your purpose, this is a macro code in which it would ask the user to enter the date it want to search in a particular column, you can change the column by changing Range("A:A") to whatever you prefer.
Sub Find_Date()
Dim FindString As Date
Dim Rng As Range
FindString = InputBox("Please Enter Date")
If Trim(FindString) <> "" Then
With ActiveWorkbook.ActiveSheet.Range("A:A")
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, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
I have created this macro code using the record function.
Sub Macro1()
Cells.Find(What:="Text to find", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range("E5").Select
ActiveCell.FormulaR1C1 = "text to enter"
Range("D6").Select
Cells.Find(What:="Text to find", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range("E9").Select
ActiveCell.FormulaR1C1 = "text to enter"
End Sub
I need this macro to continue through the same column until it cannot find any more instances of the searched for word without it going back to the top of the column.
So it starts in a column, every time it finds a specified word it tabs across 1 column and pastes in a specified word.
It continues to search for the specified word in the same column until it cannot find it without starting at the top of the column.
Hope that makes some sense.
Not sure I understand but I think what your looking for is:
For each cell in columns(4).cells
If cell.value="Text to find" Then Cell.offset(0,1) = "Text to enter"
Next cell
You can use Find and FindNext to do this quickly, ie to:
search column D for the text in StrOld
enter any matches into column E with the text in StrIn
code
Sub Recut()
Dim strAddress As String
Dim StrIn As String
Dim StrOut As String
Dim rng1 As Range
StrOld = "Old"
StrIn = "New"
Set rng1 = Range("D:D").Find(StrOld, , xlFormulas, xlWhole, , , True)
If Not rng1 Is Nothing Then
strAddress = rng1.Address
Do
rng1.Offset(0, 1) = StrIn
Set rng1 = Range("D:D").FindNext(rng1)
Loop While Not rng1 Is Nothing And rng1.Address <> strAddress
End If
End Sub