Home Stretch! *

[ChasePenelli]

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

 

[Tom Ogilvy]

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
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range("A1:CU773").Select
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

--
Regards,
Tom Ogilvy

"ChasePenelli" <[email protected]>
wrote in message

 

[ChasePenelli]

I try that new formula and all i get is errors...hmm anyone have any
ideas....


Thanks everyone!

Chase

 

[Tom Ogilvy]

The only code I added:

Sub EFG()
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range("A1:CU773").Select
X = Selection.Value

End Sub

Works just fine. Any errors must be due to your existing code,
incompatibilities with you existing code, or something to do with your
sheet.

--
Regards,
Tom Ogilvy

"ChasePenelli" <[email protected]>
wrote in message
news:[email protected]...