Consulting

Results 1 to 17 of 17

Thread: Find and Replace Multiple values in Excel

  1. #1

    Post Find and Replace Multiple values in Excel

    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.

  2. #2
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    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?
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  3. #3
    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"

    ROOM TAGS.jpg

  4. #4
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello dawoodmpm,

    Are the other worksheets the same as "ROOM TAGS" ?
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  5. #5
    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 sna
    pshot is provided with old room tags highlighted in red color text need to be replaced as new room tags.

    Enlarged View:

    room tags-1.PNG
    Full Page View:
    ROOM TAGS.jpg

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    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
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  8. #8
    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.
    Attached Files Attached Files

  9. #9
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    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
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  10. #10
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    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
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  11. #11

    Thumbs up Thread solved

    Its really works well.Thank you so much for your kind support at right time.

    Sincerely

    Dawood Abdul Kader

  12. #12
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello dawoodmpm,

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

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  13. #13
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  14. #14
    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

  15. #15
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  16. #16
    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

  17. #17
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •