How to Modify Find/Replace to refer to one cell only - vba

I have the Find/Replace code below which uses the keyword "Cells", but the result is in changing everything in the sheet. I have not been able to figure out how to make it refer to ONLY one cell.
fnd = " himself "
rplc = " herself "
'Perform the Find/Replace All
sht.Cells.Replace What:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
SearchFormat:=False, ReplaceFormat:=False
I need to refer to change only one cell. It changes everything.


Use this:
Change A1 to your respective cell
fnd = " himself "
rplc = " herself "
'Perform the Find/Replace All
sht.Range("A1").Replace What:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
SearchFormat:=False, ReplaceFormat:=False

Related

VBA loop help required

I have 2 sheets in a workbook
Sheet 1 - Where A2 and onwards I have numbers
Sheet named "LOC" , where i put 1 number at a time recalculate and formate and save it
the process has to repeat for all number entered in Sheet 1 - A2 and Below till the end of Column
Please help me loop this
I have to copy each number from Sheet 1 and paste it in heet named "LOC" in C2 and repeat the process again
Sub MultipleSOA()
'1st SOA
Sheets("Sheet1").Select
Range("A2").Select
Selection.Copy
Sheets("Loc ").Select
Range("C2").Select
ActiveSheet.Paste
ActiveSheet.Calculate
Range("B9:G9").Select
Cells.Replace What:="PCL-", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="SCL-", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="PSI-", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="CL-", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("B9:G9").Select
Range("C4").Select
Columns("C:C").ColumnWidth = 44.29
Range("C4").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\XXXX\Desktop\SOA\" & ActiveSheet.Range("B9").Value & " - " & ActiveSheet.Range("C2").Value & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub

I haven't tested it, but try the following code...
Option Explicit
Sub MultipleSOA()
Dim varItemsToReplace As Variant
Dim varItem As Variant
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim rngSource As Range
Dim rngCell As Range
varItemsToReplace = Array("PCL-", "SCL-", "PSI-", "CL-")
Set wksSource = Worksheets("Sheet1")
Set wksDest = Worksheets("Loc")
With wksSource
Set rngSource = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
For Each rngCell In rngSource
With wksDest
.Range("C2").Value = rngCell.Value
.Calculate
For Each varItem In varItemsToReplace
.Range("B9:G9").Replace _
What:=varItem, _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Next varItem
.Columns("C:C").ColumnWidth = 44.29
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\XXXX\Desktop\SOA\" & .Range("B9").Value & " - " & .Range("C2").Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
Next rngCell
End Sub

FOR loop in Excel - find and replace

I have the following code
Sub CleanCat()
Dim i As Integer
For i = 1 To 50
Columns("A").Replace What:="Cat" & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns("A").Replace What:="Cat " & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns("A").Replace What:="Category " & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns("A").Replace What:="Category" & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns("A").Replace What:="cat" & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns("A").Replace What:="cat " & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns("A").Replace What:="category " & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Columns("A").Replace What:="category" & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
End Sub
What I want is to loop through every cell in column A and do the replacements shown (I am looping through tweets) but this doesn't replace everything. I get stuff such as something cat 13 here left
Example tweets:
#thisaccount I nominate #thataccountfor category 12 #somehashtag
Cat 12 I nominate #thisaccount #somehashtag
Any ideas?

Another option without the number loop. (Note: I built on #Jeeped's answer)
It also puts the words in an array for easier updating.
Sub CleanCat()
Dim i As Long
Dim srch() As Variant
Dim srchPart As Variant
srch = Array("Category ", "Category", "Cat ", "Cat") ' make sure this is in order longest to shortest.
With Worksheets("Sheet1")
.Columns("A") = .Evaluate("INDEX("'" & A:A,)")
.Columns("A").Replace What:=Chr(160), Replacement:=Chr(32), LookAt:=xlPart
For Each srchPart In srch
.Columns("A").Replace What:=srchPart, Replacement:="}}}}", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next srchPart
.Columns("A").Replace What:="}}}}", Replacement:="Category", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With
End Sub
I also stole #Jeeped's formula to test:

This is all you should require.
Option Explicit
Sub CleanCat()
Dim i As Long
With Worksheets("sheet1")
.Columns("A").Replace What:=Chr(160), Replacement:=Chr(32), LookAt:=xlPart
For i = 50 To 1 Step -1
.Columns("A").Replace What:="Cat" & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Columns("A").Replace What:="Cat " & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Columns("A").Replace What:="Category " & i, Replacement:="Category" & i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next i
End With
End Sub
My sample data was created with,
=CHOOSE(RANDBETWEEN(1, 3), "cat", "Cat", "category")&CHOOSE(RANDBETWEEN(1, 3), TEXT(,), CHAR(32), CHAR(160))&RANDBETWEEN(1, 50)

Vba keep previous cell value or skip if vlookup returns N/A

I have a large data set of countries and their cost of living index. They need to be updated quarterly by copying a table from a website.
I made a macro to vlookup the updated index and replace the old one, but some entries no longer exist in the updated one or are not included. It leaves the index cell with #N/A, but I rather just leave the old value.
'Varibles and format
Dim last As Integer
Dim Ending As Integer
Dim examin As Variant
Ending = Cells(Rows.Count, "A").End(xlUp).Row
last = Range("G3").SpecialCells(xlCellTypeLastCell).Row
Range("F3:F" & last).ClearContents
Range("I3:M" & last).ClearContents
'Find & Replace country names with correct from
Cells.Replace What:="United States", Replacement:="USA", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="United Kingdom", Replacement:="England", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="United Arab Emirates", Replacement:="United_Arab_Emirates", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Dominican Republic", Replacement:="Dominican_Republic", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="South Africa", Replacement:="South_Africa", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Czech Republic", Replacement:="Czech_Republic", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Costa Rica", Replacement:="Costa_Rica", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Vlookup updated index
For x = 2 To Ending
Range("D" & x).Value = Application.VLookup(Range("A" & x), Range("G3:H" & last), 2, False)
Next x
End Sub
I read on this question "How to keep previous excel cell value if VLOOKUP return with error" that it was not an option, but there might be a different way.
Here is what it looks like after I run it.

For x = 2 To Ending
If isnumeric(Application.VLookup(Range("A" & x), Range("G3:H" & last), 2, False)) then
Range("D" & x).Value = Application.VLookup(Range("A" & x), Range("G3:H" & last), 2, False)
End if
Next x
End Sub
Try that

VBA / Excel - Replace value only if cell does not contain formula

I'm attempting to use the replace function to change some values, however the way I'm currently doing it will change values in vital formula.
How can I have the replace function work only on cells with no formula, within one column? I tried If Not Columns("I").HasFormula Then but that prevents the replace from working on the entire column if a formula is found.
Columns("I").Replace What:="10", _
Replacement:="Five", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="9", _
Replacement:="Four", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="8", _
Replacement:="Three", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="7", _
Replacement:="Three", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="6", _
Replacement:="Two", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="5", _
Replacement:="Two", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="4", _
Replacement:="One", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="3", _
Replacement:="One", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="2", _
Replacement:="One", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Columns("I").Replace What:="1", _
Replacement:="One", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End If

What about this:
Sub replaceFormulas()
Dim rng As Range
Set rng = Range("I:I")
With rng.SpecialCells(xlCellTypeConstants)
.Replace What:="9", Replacement:="Four", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' etc etc
End With
End Sub
If that works, next I suggest just using the workable range, as I doubt you have every cell in column I filled in. Perhaps get the last row and do
Set rng = Range("I1:I" & lastRow) to save a little time.
Note: This worked if I had cells with 9 and ="9". It just replaced 9 and kept my ="9" there.

Not the quickest macro but you could iterate over each cell like this:
Sub fixCol_I()
Dim cell As Range
Dim iMatch As Integer
Dim strWhat As Variant
Dim strReplc As Variant
strWhat = Array("10", "9", "8", "7", "6", "5", "4", "3", "2", "1")
strReplc = Array("Five", "Four", "Three", "Three", "Two", "Two", "One", "One", "One", "One")
For Each cell In Columns("I").rows
If Not cell.HasFormula And cell <> "" Then
For iMatch = 0 To UBound(strWhat)
cell.Replace What:=strWhat(iMatch), _
Replacement:=strReplc(iMatch), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Next iMatch
End If
Next cell
End Sub

Copy Multiple Columns over by Column name

I am trying to copy Columns over to another worksheet going by Column Name. The problem with the below code is that it copies over only the Price Calculator Status Column. It is overwriting the other two. Is there a better way to have this code modified so it appends rather than overwrite?
Dim aCell1, aCell2, aCell3 As Range
Dim strSearch As String
strSearch1 = "Change Request Description"
strSearch2 = "Current State"
strSearch3 = "Price Calculator Status"
'Set ws = ThisWorkbook.Sheets(1)
With wrkbk
Set aCell1 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch1, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Sheets("3. PMO Internal View").Columns(aCell.Column).Copy
Set aCell2 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch2, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Sheets("3. PMO Internal View").Columns(aCell.Column).Copy
Set aCell3 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch3, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'If Not aCell Is Nothing Then
' MsgBox "Value Found in Cell " & aCell.Address & vbCrLf & _
' "and the column number is " & aCell.Column
'~~> Do the copying here
Sheets("3. PMO Internal View").Columns(aCell1.Column).Copy
Sheets("3. PMO Internal View").Columns(aCell2.Column).Copy
Sheets("3. PMO Internal View").Columns(aCell3.Column).Copy
'Else
'MsgBox "Search value not found"
'End If
End With

Change your copy lines to:
Sheets("3. PMO Internal View").Range(Sheets("3. PMO Internal View").Columns(aCell1.Column).Address & "," & Sheets("3. PMO Internal View").Columns(aCell2.Column).Address & "," & Sheets("3. PMO Internal View").Columns(aCell3.Column).Address).Copy
This selects your columns in one step, as multiple areas like range("A:A, C:C, E:E"). the comma's are text string additions, as if you use a comma in the range command it has a different meaning.