Change a few Latin letters to Cyrillic - vba
I need to write a macro for MS Word 2010 which will change some Latin letters to Cyrillic:
U+0079 : LATIN SMALL LETTER Y
U+0065 : LATIN SMALL LETTER E
U+0061 : LATIN SMALL LETTER A
U+0070 : LATIN SMALL LETTER P
U+006F : LATIN SMALL LETTER O
To respectively:
U+0443 : CYRILLIC SMALL LETTER U (hex=443 -> dec=1091)
U+0435 : CYRILLIC SMALL LETTER IE (hex -> dec=1077)
U+0430 : CYRILLIC SMALL LETTER A (hex -> dec=1072)
U+0440 : CYRILLIC SMALL LETTER ER (hex -> dec=1088)
U+043E : CYRILLIC SMALL LETTER O (hex -> dec=1086)
My macro:
Sub replacement()
Dim zmiana(5, 1) As String
Dim iter As Integer
iter = 0
zmiana(0, 0) = "y"
zmiana(0, 1) = Chr(1091)
zmiana(1, 0) = "e"
zmiana(1, 1) = Chr(1077)
zmiana(2, 0) = "a"
zmiana(2, 1) = Chr(1072)
zmiana(3, 0) = "p"
zmiana(3, 1) = Chr(1088)
zmiana(4, 0) = "o"
zmiana(4, 1) = Chr(1086)
Do Until (iter > 4)
Selection.Find.ClearFormatting
Selection.Find.replacement.ClearFormatting
With Selection.Find
.Text = replace(iter, 0)
.replacement.Text = replace(iter, 1)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute replace:=wdReplaceAll
iter = iter + 1
Loop
End Sub
Debugger stops at Chr(1091), but I can't think of solution for this or another way...
You'll have to replace each Chr with ChrW.
Macro
Sub cir()
'
' cir Macro
'
'
Selection.Replace What:=ChrW(68) & ChrW(382), Replacement:=ChrW(1039), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(68) & ChrW(122), Replacement:=ChrW(1039), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(68) & ChrW(381), Replacement:=ChrW(1039), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(68) & ChrW(90), Replacement:=ChrW(1039), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(76) & ChrW(106), Replacement:=ChrW(1033), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(76) & ChrW(74), Replacement:=ChrW(1033), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(78) & ChrW(106), Replacement:=ChrW(1034), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(78) & ChrW(74), Replacement:=ChrW(1034), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(68) & ChrW(106), Replacement:=ChrW(1026), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(68) & ChrW(74), Replacement:=ChrW(1026), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(65), Replacement:=ChrW(1040), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(66), Replacement:=ChrW(1041), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(67), Replacement:=ChrW(1062), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(268), Replacement:=ChrW(1063), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(262), Replacement:=ChrW(1035), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(68), Replacement:=ChrW(1044), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(272), Replacement:=ChrW(1026), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(69), Replacement:=ChrW(1045), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(70), Replacement:=ChrW(1060), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(71), Replacement:=ChrW(1043), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(72), Replacement:=ChrW(1061), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(73), Replacement:=ChrW(1048), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(74), Replacement:=ChrW(1032), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(75), Replacement:=ChrW(1050), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(76), Replacement:=ChrW(1051), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(77), Replacement:=ChrW(1052), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(78), Replacement:=ChrW(1053), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(79), Replacement:=ChrW(1054), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(80), Replacement:=ChrW(1055), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(82), Replacement:=ChrW(1056), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(83), Replacement:=ChrW(1057), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(352), Replacement:=ChrW(1064), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(84), Replacement:=ChrW(1058), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(85), Replacement:=ChrW(1059), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(86), Replacement:=ChrW(1042), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(90), Replacement:=ChrW(1047), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(381), Replacement:=ChrW(1046), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(100) & ChrW(382), Replacement:=ChrW(1119), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(100) & ChrW(122), Replacement:=ChrW(1119), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(108) & ChrW(106), Replacement:=ChrW(1113), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(110) & ChrW(106), Replacement:=ChrW(1114), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(100) & ChrW(106), Replacement:=ChrW(1106), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(269), Replacement:=ChrW(1095), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(273), Replacement:=ChrW(1106), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(97), Replacement:=ChrW(1072), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(98), Replacement:=ChrW(1073), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(99), Replacement:=ChrW(1094), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(263), Replacement:=ChrW(1115), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(100), Replacement:=ChrW(1076), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(101), Replacement:=ChrW(1077), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(102), Replacement:=ChrW(1092), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(103), Replacement:=ChrW(1075), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(104), Replacement:=ChrW(1093), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(105), Replacement:=ChrW(1080), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(106), Replacement:=ChrW(1112), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(107), Replacement:=ChrW(1082), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(108), Replacement:=ChrW(1083), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(109), Replacement:=ChrW(1084), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(110), Replacement:=ChrW(1085), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(111), Replacement:=ChrW(1086), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(112), Replacement:=ChrW(1087), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(114), Replacement:=ChrW(1088), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(115), Replacement:=ChrW(1089), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(353), Replacement:=ChrW(1096), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(116), Replacement:=ChrW(1090), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(117), Replacement:=ChrW(1091), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(118), Replacement:=ChrW(1074), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(122), Replacement:=ChrW(1079), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=ChrW(382), Replacement:=ChrW(1078), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
End Sub
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
Looking to simplify my code
The code below is very repetitive and it looks like the words I need to replace can be subbed into the three lines of code one by one, I'm just not sure how to do it. If anyone is wondering it's just a bit of code to find and replace common errors. This is in Visual Basic. Thanks! Cells.Replace What:=" uk ", Replacement:=" UK ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:=" info ", Replacement:=" information ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="havant", Replacement:="haven't", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="everytime", Replacement:="every time", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="wouldnt", Replacement:="wouldn't", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="couldnt", Replacement:="couldn't", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="shouldnt", Replacement:="shouldn't", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="scottish", Replacement:="Scottish", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="havnt", Replacement:="haven't", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="must of", Replacement:="must have", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="on line", Replacement:="online", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="help full", Replacement:="helpful", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="xmas", Replacement:="Christmas", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="christmas", Replacement:="Christmas", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:=" allot ", Replacement:=" a lot", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="vip", Replacement:="VIP", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="on line", Replacement:="online", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:=" usa ", Replacement:=" USA ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:=" wales ", Replacement:=" Wales ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:=" dif ", Replacement:=" did ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:=" saif ", Replacement:=" said ", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False
You could create a multidimensional array (http://msdn.microsoft.com/en-us/library/d2de1t93(v=vs.90).aspx) that contains the original and new values Then loop through the array calling your Cells.Replace once within the loop (0 = original, 1 = replacement) Dim newArray(5,1) as string newarray(0,0) = "info" newArray(0,1) = "information" For x = 0 to 5 Cells.Replace What:=newArray(x,0), Replacement:=newArray(x,1), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next
If you don't specify all the options, then it remembers your last time. So SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False is redunant after the first time you specify. Properties, like Methods, are Function Calls, which are slowish. Each line makes 4 extra functions calls, none needed after the first line.