Find & Replace macro based on external Excel file

[xunil76]

Hi guys,

I need some help creating a find & replace macro, with the find/replace values contained in a completely separate Excel file. Here's the scenario:

I'll have a list file: D:\\Excel Files\List.xlsx
This file contains only 2 columns, one titled "Name" & the other titled "ID#".
Under these header names are thousands of rows of names & their corresponding ID numbers.
This file will never actually be opened unless it's to update the list of Names & ID#'s.

Now, I will have other files (obtained from various sources) which I need to use the contents of the file above in order to run a macro that will do a find & replace, to convert from "Name" to "ID#", or from "ID#" to "Name", depending on the current value and/or header name...basically the opposite of whatever the value is currently (each file will only have one or the other, there will never be a combination of both within a single file). The column containing this info will not always be in a specific column, but they will always be named either "Name" or "ID#". If the column header is "ID#", I want the macro to replace the values under it with the ones in the "Name" column of my "List" file, and if the column header is "Name", I want the macro to replace the values under it with the ones in the "ID#" column of my "List" file. Also, case-sensitivity and preceding zeroes must be kept intact when the values are replaced. For example:

This name = 00098348 ID#
this name = 32800123 ID#

I don't want the macro to find "This", and replace it with the ID# of 32800123. I also do not want "This" to be replaced with "98348", but with exactly "00098348".

I have come across this post, and have been trying to modify it for my needs, but I can't seem to get it working, and the author of that macro hasn't been active on here since 2014.

I'll keep poking around with it, but if someone could help out, it would be greatly appreciated.

 

[Yongle]

Hi
I fully understand what you are trying to achieve and the constraints on what constitutes a match and how the values should be returned but can you clarify a few things before I set things up incorrectly...

1. How is each ID# value stored
- are the cells formatted as text?
(in which case 00000001 is input as 00000001 and match required is 00000001)
or
- are the cells custom-formatted with format being a string of 8 zeroes "00000000"
(in which case 00000001 is entered as 1 and match required is 1)
or
- if neither, please provide details

2. Does a "Name" ever contain a space?

3. How should VBA treat a value that cannot be found?
- "will not happen" is not an acceptable answer - it always happens!!
- perhaps add a prefix to the original cell value and generate a list of unmatched items

depending on the current value and/or header name

4. That is very imprecise and VBA baulks at that
- is the header not always either "Name" or "ID#"?
- what does "and/or" mean?
- "depending on the current value" of what?

My simplistic understanding is that if the column header is "Name" then replace that with with "ID#" (or if it is "ID#" replace it with "Name") and the values follow suit
- if that is not always the case, please provide some typical examples of what VBA will find and what VBA then needs to do

thanks

 

[Yongle]

I am busy for the next few days and was too impatient to wait for a reply to my earlier questions

Assumptions
- every ID# is an integer formatted as 8 digits
- all names contain at least one alpha characters (ie cannot be numeric only)
- column A in List.xlsx is "Name"
- column B is ID#
- data begins in row immediately below header cell

If any of my assumptions are incorrect please let me know and I will post amended code

To test
- use copies of your files!
- create a new workbook and add the code below in a STANDARD module
- add a reference to Microsoft Scripting Runtime ('VBA \ Tools \ References \ scroll down to Microsoft Scripting Runtime \ "check" the box \ OK)
- verify the path to List.xlsx
- save as .xlsm

Running the macro
- open workbook to be amended and select correct worksheet
- run macro MasterSub
- user is asked to click on the "Header" cell (which identifies the column, the range to be replaced, the value of the header etc)
- if header is neither "Name" nor "ID#" then VBA asks user for more information
- after macro has run, user is given option to restore values to original

VBA summary (excl user checks)
- most of the variables are declared at top of module making them available to all procedures in the module
- there is a master sub which calls alll the other procedure
- smaller individual procedures make it easier to see what is going on
- arrays and dictionary used to minimise interaction with worksheet for improved efficiency
- user identifies header cell which VBA uses to determine the ReplacementRange
- values from List.xlsx are assigned to arrays x & x2 (one for each column) and from there inserted into a Dictionary (dict)
- a Dictionary is case-sensitive by default
- values from ReplacementRange are assigned to array y
- each value in y is looked up in the Dictionary to obtain its replacement value
- the replacement value is placed in array y2
- if the value is not found, it is given a prefix before being inserted in y2
- y2 is then assigned to ReplacementRange

Hopefully this sets you well on your way....

Option Explicit
[I][COLOR=#000080]'add reference to Microsoft Scripting Runtime
'VBA \ Tools \ Reference \ scroll down to Microsoft Scripting Runtime \ "check" the box \ OK[/COLOR][/I]
Private x, x2, y, y2, A As Range, B As Range
Private hdr As Range, header As String, values As Range
Private i As Long, msg As String, ttl As String, h
Private dict As Object

[B]Sub MasterSub()[/B]
    ValuesToBeReplaced
    CreateDictionary
    ReplaceValues
    OptionRestoreOriginalValues
End Sub

[B]Private Sub ValuesToBeReplaced()[/B]
    msg = "Click on HEADER and then click OK" & vbCr
    ttl = "Identify cell containing header"
    Set hdr = Application.InputBox(msg, ttl, , , , , , 8)
    h = hdr.Value:  header = h                                          'need to retain h
    VerifyHeader
    Set values = Range(hdr.Offset(1), hdr.Offset(Rows.Count - hdr.Row).End(xlUp))
    Application.ScreenUpdating = False
    values.Value = values.Value                                         'tidies up "number as text"  anomolies
End Sub

[B]Private Sub CreateDictionary()[/B]
    Dim wb As Workbook: Set wb = Workbooks.Open("[COLOR=#ff0000]D:\Excel Files\List.xlsx[/COLOR]")
    Set A = wb.Sheets(1).Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set B = A.Offset(, 1)
    Set dict = CreateObject("Scripting.Dictionary")
    Select Case header = "Name"
        Case True:  x = A.Value: x2 = B.Value
        Case Else:  x = B.Value: x2 = A.Value
    End Select
    wb.Close False
'add values to dictionary
    For i = 1 To UBound(x, 1)
        dict.Item(x(i, 1)) = x2(i, 1)
    Next i

End Sub

[B]Private Sub ReplaceValues()[/B]
'create array of old values and array of replacement values
        y = values.Value
        ReDim y2(1 To UBound(y, 1), 1 To 1)
            For i = 1 To UBound(y, 1)
                Select Case dict.Exists(y(i, 1))
                    Case True:      y2(i, 1) = dict(y(i, 1))
                    Case Else:      y2(i, 1) = "???  " & y(i, 1)
                End Select
            Next i
'assign new values to worksheet
        values.Value = y2
        If header = "Name" Then hdr = "ID#" Else hdr = "Name"
        values.NumberFormat = "00000000"
        hdr.Activate
    Application.ScreenUpdating = True
End Sub

[B]Private Sub OptionRestoreOriginalValues()[/B]
    msg = "Cancel to restore original values" & vbCr & vbCr & "OK to accept new values"
    ttl = "User confirmation"
    If MsgBox(msg, vbOKCancel, ttl) <> vbOK Then
        values.Value = y
        values.NumberFormat = "00000000"
        hdr = h
    End If
End Sub

[B]Private Sub VerifyHeader()[/B]
'allow user to opt in or out if header is not as expected
    If LCase(header) <> "name" And LCase(header) <> "id#" Then      'avoids upper\lower case issues
        hdr.Activate
        msg = "Options" & vbCr
        msg = "QUIT" & vbTab & "Get me outta here" & vbCr
        msg = msg & "1" & vbTab & "Replacing Name with ID#" & vbCr
        msg = msg & "2" & vbTab & "Replacing ID# with Names"
        ttl = "??? Unexpected header value:  " & header
        Select Case InputBox(msg, ttl, "QUIT")
            Case 1: header = "Name"
            Case 2: header = "ID#"
            Case Else: End
        End Select
    End If
End Sub

 

[xunil76]

Yongle,

This is awesome, sorry I haven't been back here until now, but was out of town all weekend.

So for your questions:
#1 : I always format the numbers as text, both in the source file, as well as in the file to be modified; that way, it retains all the digits (including preceding zeroes) without converting long numbers to scientific notation.
#2 : Yes, the "Name" will contain spaces, and in some cases, will be comprised of only numbers.
#3 : Maybe leave the value intact, but fill the cell background with the color red?
#4 : Sorry, the "and/or" just means that I needed the conversion done to be the opposite of what it currently is (if the header is "Name" and the value of the items below it are the names, then those values need to be converted to the ID#, and vice-versa). Your understanding was basically correct, although I didn't necessarily need it to change the column header (but that's fine, I don't need that removed).

I've tested this out and it seems to be working pretty well. I may also want to modify this for use in other things as well (using different headers, for instance), so would it be possible for you to color code which items here would need to be changed in such a scenario? I thought all it would require was to replace "Name" & "ID#" with the new values, but when I tried that, it didn't work anymore. If that is all that needs to be done, just let me know, and I'll try again and make sure I didn't make any typos or whatever.

And thanks very much for the help, this will definitely make things a lot easier than doing multiple manual find/replace operations.

 

[xunil76]

hey, just an update...i was able to modify this for use with other things, so no need to color-code anything. turns out i had a typo in the original alteration, but it's working now that i've taken care of that.

 

[Yongle]

Glad you are making progress

Numbers as Text
One of my assumptions - every ID# is an integer formatted as 8 digits (this is a NUMBER not text)
But your reply - "I always format the numbers as text"

It is possible that my code could convert your text back into numbers
Try removing these lines wherever they appear (perhaps comment them out by prefixing with apostrophe to test this suggestion )

values.Value = values.Value
values.NumberFormat = "00000000"

I do not think you should need to use this, but the code to format range variable values as text is

values.NumberFormat = "@"

Those annoying green warning triangles
Excel has the annoying habit of delivering the green triangle warning us that numbers are text when that was clearly our intention when we formatted the range as text
- code below removes those triangles
- add it to the same module
- call it by inserting this as the last line in MasterSub

RemoveAnnoyingGreenTriangles

Private Sub RemoveAnnoyingGreenTriangles()
    Dim e As Integer, cel As Range
    For Each cel In values
        For e = 1 To 4
              If cel.Errors.Item(e).Value Then cel.Errors.Item(e).Ignore = True
        Next e
    Next
End Sub

 

[Yongle]

#3 : Maybe leave the value intact, but fill the cell background with the color red?

In ReplaceValues try amending Select Case conditions to this

                Select Case dict.Exists(y(i, 1))
                    Case True
                        y2(i, 1) = dict(y(i, 1))
                    Case Else
                        y2(i, 1) = y(i, 1)
                        values.Cells(i, 1).Interior.Color = vbRed
                End Select

 

[xunil76]

hey there, sorry i haven't replied lately...been super busy at work and at home, and kinda had to put this on the back-burner for a bit. that said, i was still able to work with this to get done what i needed to get done for this go-round.

when i say that i format the numbers as text, that's actually how i wanted the numbers to appear in the selected columns. for instance, if using the option values.NumberFormat = "00000000", and i put the number "648" into that cell, when i look at the cell normally, it shows "00000648". however, if i look at the entry bar at the top where you can edit the value, it still shows only "648". if i copy that cell and paste it into a different cell (even with that cell formatted as text), it only copies the "648" instead of "00000648". i was trying to look for a way for the find/replace to always format it such that the actual value that it puts in the cell is "00000648" (formatted as text to preserve the preceding zeroes), both in the cell and in the edit bar at the top, because that's how the values are formatted in the find/replace source file.

if this is not possible, it's not a huge deal though. i was able to replace the values without the preceding zeroes with values that included them...i just added a column to the right of the one with the values, formatted that entire column as text, then copied and "paste values" into the new column, which pastes them with the zeroes intact. then i just cut/pasted that column back over the original one, and the preceding zeroes remained. a little less automatic than i would have liked, but it does work, and it's still much better than replacing tens of thousands of values manually.

I've also replaced the "Select Case" section above, and i'll see if that works if/when there is a missing value.