PDA

View Full Version : Find and Replace Multiple values in Excel



dawoodmpm
12-15-2018, 05:07 AM
Hi friends,

I want run a find and replace on multiple values from work files .

I have 2 Excel files,files from the first worksheet contains old Room number and new room number as follows
Column-A Column-B
Old Room tag New room Tag

-1.712 B-R121
-1.651 C-F677
- - - - around 500 values continues in columns as mentioned above.

In 2nd files contain multiple worksheet (50 worksheet),Above mentioned old room taggs are mentioned in the 50 worksheets which need to be repalce as new room tags. i am struggling to replace those taggs.Please advice the macro code which will be easy me to complete my task.

Leith Ross
12-15-2018, 08:17 PM
Hello dawoodmpm,


Are the room numbers on the other worksheets in specific columns?


If the columns have headers then which headers are the room numbers under?

dawoodmpm
12-15-2018, 11:04 PM
Thanks for your quick response Laith

Yes ,The Room tags are located in the different worksheet named "ROOM TAGS ".In column A Contains Old Room tags with header named "OLD ROOM TAGS", Similarly Colum B having New room Tags with Header named "NEW ROOM TAGS"

23416

Leith Ross
12-15-2018, 11:44 PM
Hello dawoodmpm,

Are the other worksheets the same as "ROOM TAGS" ?

dawoodmpm
12-16-2018, 12:36 AM
Hi Leith,

Thanks for your kind reply.

Are the other worksheets the same as "ROOM TAGS" ?

Yes. Same room tags are available in the different work sheets.

(I just want to replace the old room tags with the present new room tags)

For your easy understanding.The snapshot is provided with old room tags highlighted in red color text need to be replaced as new room tags.

Enlarged View:

23418
Full Page View:
23417

Paul_Hossler
12-16-2018, 10:24 AM
It usually works better to attach a sample workbook with all pertenent data and the macros (if any) instead of screen shots, especially since someone can't even copy/paste data from a screen shot to generate test data to try and help

Leith Ross
12-16-2018, 08:46 PM
Hello dawoodmpm.

This is has been tested using the examples you provided. However, I cannot guarantee it will work with your actual data since it has been tested on such a limited data set.

Run this macro on a copy of your workbook before installing it in your main workbook. Let me know what your results are.



' Thread: http://www.vbaexpress.com/forum/showthread.php?64251-Find-and-Replace-Multiple-values-in-Excel
' Poster: dawoodmpm
' Written: December 16, 2018
' Author: Leith Ross


Sub Macro1()


Dim Cell As Range
Dim Data As Variant
Dim Index As Long
Dim Matches As Object
Dim NewTag As Variant
Dim OldTag As Variant
Dim RegExp As Object
Dim Rng As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim Tag As Variant
Dim Tags As Object
Dim Text As String
Dim Wks As Worksheet

Set Wks = ThisWorkbook.Worksheets("Room Tags")

Set RngBeg = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
Set Rng = Wks.Range(RngBeg, RngEnd)

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.MultiLine = True
RegExp.Pattern = "\(-?\d+\.\w+\)"

Set Tags = CreateObject("Scripting.Dictionary")
Tags.CompareMode = vbTextCompare

For Each Cell In Rng
OldTag = Trim(Cell)
NewTag = Trim(Cell.Offset(0, 1))

If OldTag <> "" Then
If Not Tags.Exists(OldTag) Then
Tags.Add OldTag, NewTag
End If
End If
Next Cell

For Each Wks In ThisWorkbook.Worksheets
If UCase(Wks.Name) <> "ROOM TAGS" Then
Set RngBeg = Wks.Range("H11")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
Set Rng = Wks.Range(RngBeg, RngEnd)

If RngEnd.Row >= RngBeg.Row Then
If Rng.Cells.Count = 1 Then
ReDim Data(1, 1)
Data(1, 1) = Rng.Value
Else
Data = Rng.Value
End If

For Index = 1 To UBound(Data, 1)
Text = Data(Index, 1)
Set Matches = RegExp.Execute(Text)
For Each OldTag In Matches
NewTag = Tags(OldTag)
Text = Replace(Text, OldTag, NewTag, OldTag.FirstIndex + 1, 1, vbTextCompare)
Next OldTag
Data(Index, 1) = Text
Next Index

Rng.Value = Data
End If
End If
Next Wks

End Sub

dawoodmpm
12-16-2018, 11:23 PM
Hi Leith,

I have tried with above VBA code.It is totally deleting all the data in this excel file wherever room number consists.So i have attached my excel file with this thread for your easy reference.Please check.

Leith Ross
12-16-2018, 11:55 PM
Hello dawoodmpm,

Yeah I found a couple odd things in the macro's behaviour. I just finished making the changes and test it. This will work correctly for the sample.

Thanks for the workbook. I will try it on its data.



Sub Macro2()


Dim Cell As Range
Dim cnt As Long
Dim Data As Variant
Dim Index As Long
Dim Matches As Object
Dim NewTag As Variant
Dim OldTag As Variant
Dim RegExp As Object
Dim Rng As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim Tag As Variant
Dim Tags As Object
Dim Text As String
Dim Wks As Worksheet

Set Wks = ThisWorkbook.Worksheets("Room Tags")

Set RngBeg = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
Set Rng = Wks.Range(RngBeg, RngEnd)

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.MultiLine = True
RegExp.Pattern = "(?:\()(-?\d+\.\w+)(?:\))"

Set Tags = CreateObject("Scripting.Dictionary")
Tags.CompareMode = vbTextCompare

For Each Cell In Rng
OldTag = Trim(Cell)
NewTag = Trim(Cell.Offset(0, 1))

If OldTag <> "" Then
If Not Tags.Exists(OldTag) Then
Tags.Add OldTag, NewTag
End If
End If
Next Cell

For Each Wks In ThisWorkbook.Worksheets
If UCase(Wks.Name) <> "ROOM TAGS" Then
Set RngBeg = Wks.Range("H11")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
Set Rng = Wks.Range(RngBeg, RngEnd)

If RngEnd.Row >= RngBeg.Row Then
If Rng.Cells.Count = 1 Then
ReDim Data(1, 1)
Data(1, 1) = Rng.Value
Else
Data = Rng.Value
End If

For Index = 1 To UBound(Data, 1)
Text = Data(Index, 1)
Set Matches = RegExp.Execute(Text)

For cnt = 0 To Matches.Count - 1
OldTag = Matches(cnt).SubMatches(0)
NewTag = Tags(OldTag)

If NewTag <> "" Then
Text = Left(Text, Matches(cnt).FirstIndex + 1 - cnt) & NewTag _
& Right(Text, Len(Text) - (Matches(cnt).FirstIndex + Matches(cnt).Length - 1 - cnt))
End If
Next cnt

Data(Index, 1) = Text
Next Index

If Rng.Cells.Count = 1 Then
Rng.Value = Data(1, 1)
Else
Rng.Value = Data
End If
End If
End If
Next Wks

End Sub

Leith Ross
12-17-2018, 12:15 AM
Hello dawoodmpm,

Okay, third time is the charm. I used this macro in the workbook you attached. It appears to me that it is working. Of course, you know better than anyone if it is. Use this one...


' Thread: http://www.vbaexpress.com/forum/showthread.php?64251-Find-and-Replace-Multiple-values-in-Excel
' Poster: dawoodmpm
' Written: December 16, 2018
' Author: Leith Ross


Sub Macro3()


Dim Cell As Range
Dim cnt As Long
Dim Data As Variant
Dim Index As Long
Dim Matches As Object
Dim NewTag As Variant
Dim OldTag As Variant
Dim RegExp As Object
Dim Rng As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim Tag As Variant
Dim Tags As Object
Dim Text As String
Dim Wks As Worksheet

Set Wks = ThisWorkbook.Worksheets("Room Tags")

Set RngBeg = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
Set Rng = Wks.Range(RngBeg, RngEnd)

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.MultiLine = True
RegExp.Pattern = "(?:\()(-?\d+\.\w+)(?:\))"

Set Tags = CreateObject("Scripting.Dictionary")
Tags.CompareMode = vbTextCompare

For Each Cell In Rng
OldTag = Trim(Cell)
NewTag = Trim(Cell.Offset(0, 1))

If OldTag <> "" Then
If Not Tags.Exists(OldTag) Then
Tags.Add OldTag, NewTag
End If
End If
Next Cell

For Each Wks In ThisWorkbook.Worksheets
Select Case UCase(Wks.Name)
Case Is = "ROOM TAGS", "WORK FILE", "MAIN DB DATA"
' Skip these Worksheets
Case Else
Set RngBeg = Wks.Range("H11")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
Set Rng = Wks.Range(RngBeg, RngEnd)

If RngEnd.Row >= RngBeg.Row Then
If Rng.Cells.Count = 1 Then
ReDim Data(1, 1)
Data(1, 1) = Rng.Value
Else
Data = Rng.Value
End If

For Index = 1 To UBound(Data, 1)
Text = Data(Index, 1)
Set Matches = RegExp.Execute(Text)

For cnt = 0 To Matches.Count - 1
OldTag = Matches(cnt).SubMatches(0)
NewTag = Tags(OldTag)

If NewTag <> "" Then
Text = Left(Text, Matches(cnt).FirstIndex + 1 - cnt) & NewTag _
& Right(Text, Len(Text) - (Matches(cnt).FirstIndex + Matches(cnt).Length - 1 - cnt))
End If
Next cnt

Data(Index, 1) = Text
Next Index

If Rng.Cells.Count = 1 Then
Rng.Value = Data(1, 1)
Else
Rng.Value = Data
End If
End If
End Select
Next Wks

End Sub

dawoodmpm
12-17-2018, 04:01 AM
Its really works well.Thank you so much for your kind support at right time.

Sincerely

Dawood Abdul Kader

Leith Ross
12-17-2018, 07:57 AM
Hello dawoodmpm,

You're welcome. If you have any questions about how the macro works, just ask me.

Paul_Hossler
12-17-2018, 09:04 AM
Since this seemed to be a one time macro and performance most likely wasn't an issue, I wasn't making my offering nearly as elegant as Leith's


This is a simple looping version that I figured I might as well post since I almost had it finished




Option Explicit


Sub UpdateRooms()

Dim rRooms As Range, rRoom As Range
Dim ws As Worksheet

Set rRooms = Worksheets("ROOM TAGS").Cells(1, 1).CurrentRegion

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets

Select Case ws.Name
Case "ROOM TAGS", "work file", "MAIN DB DATA"

Case Else
For Each rRoom In rRooms.Rows
Application.StatusBar = "Worksheet = " & ws.Name & " New Room row number " & rRoom.Row
Call Range(ws.UsedRange, ws.Columns(8)).Replace(rRoom.Cells(1).Value, rRoom.Cells(2).Value, xlPart)
Next
End Select
Next

Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

dawoodmpm
12-18-2018, 11:14 PM
Hi Mr.Paul,

Hope you are doing good and Thanks for your Support.

I really appreciate both of you(Leith &Paul) for your efforts to spending your valuable time on unknown face.

This macro code is also really nice and very simple,but values are changing in first worksheet of the excel file and also i have received Pop Up error msge like"Run Time error -1004",once the value changed.

Your sincerely

Dawood

Paul_Hossler
12-19-2018, 05:31 AM
Hmmmm - I took a look even if you don't need it

By making the macro simple, there's less to go wrong and less to debug

I ran the macro on the attached and it seems to replace rooms and did not get a 1004 error

I'm using Excel 2016

dawoodmpm
12-27-2018, 06:58 AM
Hi Mr.Paul,

Hope you are doing good.

I have tried with your Macro.It works well.Some room names are not changing due to mismatches.So I am facing problem to identify the changed room name and tags.

Is it possible to make the letters bolt whichever had changed in this worksheet?Please help

sincerely,

Dawood

Paul_Hossler
12-27-2018, 06:03 PM
One new line, and one changed line

The Bold version didn't show up too well, so I tried Green shading



Sub UpdateRooms()
Dim rRooms As Range, rRoom As Range
Dim ws As Worksheet

Set rRooms = Worksheets("ROOM TAGS").Cells(1, 1).CurrentRegion

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets

Select Case ws.Name
Case "ROOM TAGS", "work file", "MAIN DB DATA"

Case Else
For Each rRoom In rRooms.Rows
Application.StatusBar = "Worksheet = " & ws.Name & " New Room row number " & rRoom.Row

' Application.ReplaceFormat.Font.Bold = True ' new line, but didn't show very well
Application.ReplaceFormat.Interior.Color = vbGreen ' different new line, shows better
Call Range(ws.UsedRange, ws.Columns(8)).Replace(rRoom.Cells(1).Value, rRoom.Cells(2).Value, xlPart, , , , , True) ' changed


Next
End Select
Next

Application.StatusBar = False
Application.ScreenUpdating = True

End Sub