Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 -- ChasePenelli ------------------------------------------------------------------------ ChasePenelli's Profile: http://www.excelforum.com/member.php...o&userid=24619 View this thread: http://www.excelforum.com/showthread...hreadid=382551 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" wrote in message news:ChasePenelli.1raoiy_1119892004.4904@excelforu m-nospam.com... 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 -- ChasePenelli ------------------------------------------------------------------------ ChasePenelli's Profile: http://www.excelforum.com/member.php...o&userid=24619 View this thread: http://www.excelforum.com/showthread...hreadid=382551 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() I try that new formula and all i get is errors...hmm anyone have any ideas.... Thanks everyone! Chase -- ChasePenelli ------------------------------------------------------------------------ ChasePenelli's Profile: http://www.excelforum.com/member.php...o&userid=24619 View this thread: http://www.excelforum.com/showthread...hreadid=382551 |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" wrote in message ... I try that new formula and all i get is errors...hmm anyone have any ideas.... Thanks everyone! Chase -- ChasePenelli ------------------------------------------------------------------------ ChasePenelli's Profile: http://www.excelforum.com/member.php...o&userid=24619 View this thread: http://www.excelforum.com/showthread...hreadid=382551 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do I expand/stretch one cell in an Excel workshet. | Excel Discussion (Misc queries) | |||
Stretch a Pie Chart | Excel Discussion (Misc queries) | |||
Shortcut keys: CNTRL+HOME vs. HOME | Excel Discussion (Misc queries) | |||
How do I stretch the height of a font in Excel 2003 | Excel Worksheet Functions | |||
Can I stretch an Excel document vertically when printing? | Excel Discussion (Misc queries) |