LinkBack URL
About LinkBacks
Home Stretch! *
Alright So i have a macro to do my bidding...I think : This is for changing all the abbriviations in column 1 to the words in column 2 of sheet 2 INTO sheet one's information... So my question is how can i change it to search (change range?) to the one on my doucument. The dementions are as follows: From Column A - CU and it is 763 rows! :
Well here is the Macro right now... Just asking is this will change the items from sheet2 on sheet1 and how to make it search over that vast amount of space!
Thanks everyone for your help thus far!~
Sub Replacer()
'Does a Find and Replace on whole words throughout the selected range. Uses a table of _
Find And Replace strings taken from Sheet2 columns A And B _
Uses regular expressions For search To make sure found strings are complete words _
Uses arrays For speed For range To be searched And For source of Find/Replace strings. _
Note: will wipe out all formulas In the selected range!
Dim RgExp As Object
Dim rg As Range
Dim X As Variant, Y As Variant
Dim i As Long, j As Long, k As Long, nColumns As Long, nFindReplace As Long, nRows As Long
Dim FindReplacePrompt As String
FindReplacePrompt = "I couldn't find the Find/Replace strings at Sheet2!A1:Bxx. Please select them now." & _
" No blanks allowed in first column!"
If Selection.Cells.Count = 1 Then
If Selection = "" Then
MsgBox "Please select some cells to run the macro on, then try again"
Exit Sub
Else
ReDim X(1 To 1, 1 To 1)
X(1, 1) = Selection
End If
Else
X = Selection.Value
End If
'Populate the array variable Y with Find/Replace strings. Default source is Sheet2, A1:Bxx
On Error Resume Next
Set rg = Worksheets("Sheet2").Range("F1")
If rg Is Nothing Then
Set rg = Application.InputBox(prompt:=FindReplacePrompt, Title:="Source of Find/Replace strings", Type:=8)
If rg Is Nothing Then Exit Sub
Else
If rg.Cells(1, 1) = "" Then
Set rg = Application.InputBox(prompt:=FindReplacePrompt, Title:="Source of Find/Replace strings", Type:=8)
If rg Is Nothing Then Exit Sub
Else
Set rg = Range(rg, rg.End(xlDown).Offset(0, 1))
End If
End If
On Error GoTo 0
Y = rg.Value
nFindReplace = UBound(Y)
Set RgExp = CreateObject("VBScript.RegExp")
With RgExp
.Global = True
'.IgnoreCase = True 'True if search is case insensitive. False otherwise
End With
nRows = UBound(X)
nColumns = UBound(X, 2)
For i = 1 To nFindReplace
RgExp.Pattern = "\b" & Y(i, 1) & "\b"
For j = 1 To nRows
For k = 1 To nColumns
X(j, k) = RgExp.Replace(X(j, k), Y(i, 2))
Next k
Next j
Next i
Set RgExp = Nothing
Selection.Value = X 'Replace cell values with the edited strings
End Sub
Register To Reply
Hmm
Bookmarks