How to find substituting value while find and replace in macro

Vky · Apr 6th 2020

Code

My code replaces Corporation to Corp and Incorporated  to Inc. but what i need is, i want to identify which value is replacing, so i want that replacing value in Column B. that is Corporation in B2 and Incorporated in B3.  My input and replacing list may go upto 10000 rows. attached sample file for reference.





Sub RemoveSpecialWithSpace()
Dim Rng As Range
Dim InputRng As Range, ReplaceRng As Range
Set InputRng = Sheets("Original Range").Range("A1", Sheets("Original Range").Range("A" & Rows.Count).End(xlUp))
Set ReplaceRng = Sheets("Replace Range").Range("A1:B4")
For Each Rng In ReplaceRng.Columns(1).Cells
    InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
End Sub

Display More

Input (Sheet 1 Column A)	Find (sheet 2 Column A)	Replace With ((sheet 2 Column B)	Output
ABC Corporation	Corporation	Corp	ABC Corp
ABC Incorporated	Incorporated	Inc	ABC Inc

Vky · Apr 6th 2020

A Column	B Column
ABC Corp	Corporation
ABC Inc	Incorporated

i want output like this

ArdusPetus · Apr 6th 2020

Code

Option Explicit

Sub Replace()

Dim wOR As Worksheet, wRR As Worksheet
Dim rngIn As Range
Dim tabRepl As Variant
Dim i As Long
    Set wOR = Worksheets("Original Range")
Set wRR = Worksheets("Replace Range")

tabRepl = wRR.[A1].CurrentRegion

For Each rngIn In Range(wOR.[A2], wOR.Cells(Rows.Count, "A").End(xlUp))
    For i = LBound(tabRepl) To UBound(tabRepl)
        If InStr(1, rngIn, tabRepl(i, 1)) > 0 Then
            wOR.Cells(rngIn.Row, "C") = tabRepl(i, 1)
            wOR.Cells(rngIn.Row, "E") = tabRepl(i, 2)
            wOR.Cells(rngIn.Row, "G") = Strings.Replace(rngIn, tabRepl(i, 1), tabRepl(i, 2))
            Exit For
        End If
    Next i
Next rngIn
End Sub
[attach=1227660][/attach]

HTH,
-- 
AP

Display More

Vky · Apr 6th 2020

Thanks bro for the help.

Works partially...

i saw some of the rows are not replaced and Blanks .. Kindly check..... attached file for your reference.

Vky · Apr 6th 2020

Thanks bro for the help.

Works partially...

i saw some of the rows are not replaced and Blanks .. Kindly check..... attached file for your reference.

Quote from ArdusPetus

Code

Option Explicit

Sub Replace()

Dim wOR As Worksheet, wRR As Worksheet
Dim rngIn As Range
Dim tabRepl As Variant
Dim i As Long
    Set wOR = Worksheets("Original Range")
Set wRR = Worksheets("Replace Range")

tabRepl = wRR.[A1].CurrentRegion

For Each rngIn In Range(wOR.[A2], wOR.Cells(Rows.Count, "A").End(xlUp))
    For i = LBound(tabRepl) To UBound(tabRepl)
        If InStr(1, rngIn, tabRepl(i, 1)) > 0 Then
            wOR.Cells(rngIn.Row, "C") = tabRepl(i, 1)
            wOR.Cells(rngIn.Row, "E") = tabRepl(i, 2)
            wOR.Cells(rngIn.Row, "G") = Strings.Replace(rngIn, tabRepl(i, 1), tabRepl(i, 2))
            Exit For
        End If
    Next i
Next rngIn
End Sub
[attach=1227660][/attach]

HTH,
-- 
AP

Display More

Vky · Apr 6th 2020

I find that, those rows are not replaced because of Case sensitive.... please remove Case sensitive bro.. Thanks....

Quote from ArdusPetus

Code

Option Explicit

Sub Replace()

Dim wOR As Worksheet, wRR As Worksheet
Dim rngIn As Range
Dim tabRepl As Variant
Dim i As Long
    Set wOR = Worksheets("Original Range")
Set wRR = Worksheets("Replace Range")

tabRepl = wRR.[A1].CurrentRegion

For Each rngIn In Range(wOR.[A2], wOR.Cells(Rows.Count, "A").End(xlUp))
    For i = LBound(tabRepl) To UBound(tabRepl)
        If InStr(1, rngIn, tabRepl(i, 1)) > 0 Then
            wOR.Cells(rngIn.Row, "C") = tabRepl(i, 1)
            wOR.Cells(rngIn.Row, "E") = tabRepl(i, 2)
            wOR.Cells(rngIn.Row, "G") = Strings.Replace(rngIn, tabRepl(i, 1), tabRepl(i, 2))
            Exit For
        End If
    Next i
Next rngIn
End Sub
[attach=1227660][/attach]

HTH,
-- 
AP

Display More

ArdusPetus · Apr 6th 2020

The output fields were blank because there is nothing to replace in the input field.

I modified the macro so that, in case no keyword was found in input, it prints input without changes in output field.

Replacement v1.1.xlsm

Vky · Apr 6th 2020

Thanks bro...!!!!!!!!!! Works perfectly.....

Vky · Apr 6th 2020

Quote from ArdusPetus

The output fields were blank because there is nothing to replace in the input field.
I modified the macro so that, in case no keyword was found in input, it prints input without changes in output field.
Replacement v1.1.xlsm

Thanks bro...!!!!!!!!!! Works perfectly.....

How to find substituting value while find and replace in macro

Participate now!

Share