A macro solution - replace text given the values

  • Thread starter Thread starter Sinner
  • Start date Start date
Sub ReplaceData()
Dim cell As Range
Dim res As Variant

With ActiveSheet

For Each cell In .UsedRange

On Error Resume Next
res = Application.VLookup(cell.Value,
Worksheets("Temp").Columns("A:B"), 2, False)
On Error GoTo 0
If Not IsError(res) Then cell.Value = res
Next cell
End With

End Sub
 
Hi,

Right click sheet 1 tab, view code and paste this in and run it

Sub standard()
For Each c In ActiveSheet.UsedRange
On Error Resume Next
If Not IsEmpty(c) Then
c.Value = WorksheetFunction.VLookup(c.Value, Sheets("Temp").Range("A1:B4"),
2, False)
End If
Next
End Sub

Mike
 
Hi,

Right click sheet 1 tab, view code and paste this in and run it

Sub standard()
For Each c In ActiveSheet.UsedRange
    On Error Resume Next
    If Not IsEmpty(c) Then
c.Value = WorksheetFunction.VLookup(c.Value, Sheets("Temp").Range("A1:B4"),
2, False)
    End If
Next
End Sub

Mike








- Show quoted text -

Thx bob & mike : )

Mike can u go through your code once again. It seems something is
missing.

Thx.
 
Hi,

Nothing is missing that i'm aware of. It simply loops through every cell in
the used range and if the cell contains a value it does a vlookup of that
value on the temp sheet. If it finds a match it populates that value in the
cell and if it doesn't it resumes next because of the error generated. The
only potential problem I can see is this line has line wrapped when posted
and is really a single line.

c.Value = WorksheetFunction.VLookup(c.Value, Sheets("Temp").Range("A1:B4"),
2, False)


What problem are you getting?


Mike
 
Hi,

Nothing is missing that i'm aware of. It simply loops through every cell in
the used range and if the cell contains a value it does a vlookup of that
value on the temp sheet. If it finds a match it populates that value in the
cell and if it doesn't it resumes next because of the error generated. The
only potential problem I can see is this line has line wrapped when posted
and is really a single line.

c.Value = WorksheetFunction.VLookup(c.Value, Sheets("Temp").Range("A1:B4"),
2, False)

What problem are you getting?

Mike








- Show quoted text -

Dear Mike,

Both are wokring but now the problem is that I have a lot of data &
it's taking too much time. Vlooup calculation time is wayyyy too long.
Find/Replace is much faster but can we get it through VB?

Thx.
 
Sub way()
Dim strNm As String
Dim rngData As Range
Dim cel As Range
Dim rngReplacement As Range
Dim strReplacement As String

'change to the range where your data is
Set rngData = Sheet1.UsedRange

'change to the range where your conversion table is
Set rngReplacement = Sheet2.UsedRange

For Each cel In rngData

strNm = cel.Value

On Error Resume Next
If cel.Value <> "" Then
strReplacement = _
rngReplacement.Find( _
What:=strNm, _
After:=Sheet2.Range("a1"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True, _
SearchFormat:=False) _
.Offset(0, 1).Value
If strReplacement <> "" Then _
cel.Replace _
What:=strNm, _
replacement:=strReplacement, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
MatchCase:=True, _
SearchFormat:=False, _
ReplaceFormat:=False
End If
Next cel

On Error GoTo 0

End Sub

Cliff Edwards
 
Sub way()
Dim strNm As String
Dim rngData As Range
Dim cel As Range
Dim rngReplacement As Range
Dim strReplacement As String

'change to the range where your data is
Set rngData = Sheet1.UsedRange

'change to the range where your conversion table is
Set rngReplacement = Sheet2.UsedRange

For Each cel In rngData

strNm = cel.Value

On Error Resume Next
If cel.Value <> "" Then
    strReplacement = _
        rngReplacement.Find( _
        What:=strNm, _
        After:=Sheet2.Range("a1"), _
        LookIn:=xlFormulas, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=True, _
        SearchFormat:=False) _
        .Offset(0, 1).Value
If strReplacement <> "" Then _
    cel.Replace _
        What:=strNm, _
        replacement:=strReplacement, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        MatchCase:=True, _
        SearchFormat:=False, _
        ReplaceFormat:=False
End If
Next cel

On Error GoTo 0

End Sub

Cliff Edwards

Edward,

The code replaces but has two bugs:

- It is replacing every used cell in sheet
- The code replacement is case sensitive

Pls ammend & revert.

Thx
 
Sinner - change the range variable to the range you want processed:

In the following line, change "Sheet1.UsedRange" to whatever range you
want to process.

'change to the range where your data is
Set rngData = Sheet1.UsedRange

There are two instances of this line in the sub:
MatchCase:=True

Replace them with this line:
MatchCase:=False

Cliff Edwards
 
Back
Top