Highlight Postcodes in XML Files

[Chris Waller]

Hi All,

I have a small excel problem that I need a little help with.

I have a Spreadsheet that contains part of a postcode in column A to be exact the data is between A3 and A63 although there is potential for this to expand. The column contains either the first part of the postcode OL7, M43, or the first part and the first digit of the second part of the postcode WN2 5.

What I am trying to do is to highlight on a couple of XML files any postcode that appears on the Excel Spreadsheet however, the data on the XML files is in a slightly different format. For example the format is as follows
OL7,
M43,
WN2/5.

As I am unsure of the name formats of the files, if it helps I could put the three files in the same directory.

Any help would be greatly appreciated. TIA

 

[pbornemeier]

Q1. Can the .xml files be opened with Excel (are they tabular in nature or more like a text document?)
Q2. What do you mean by highlight (bold?, change color?, both? something else?)
Q3. What is the name of the worksheet containing the post code?
Q4. The codes can be highlighted while open in the Excel document. Do you want to save them with the highlighting intact?
Q5. The postal codes appear to be for UK which has two basic formats (A[A]N[A/N] or A[A]N[A/N] NAA see https://en.wikipedia.org/wiki/List_of_postal_codes for details) is that correct?
Q6. Is the slightly different format in all cases that a space in the postal code is always replaced by a slash (/) or are there other differences?
Q7. What do you mean by 'there is potential for this to expand'? How could it expand?

 

[Chris Waller]

Q1. Can the .xml files be opened with Excel (are they tabular in nature or more like a text document?)
Q2. What do you mean by highlight (bold?, change color?, both? something else?)
Q3. What is the name of the worksheet containing the post code?
Q4. The codes can be highlighted while open in the Excel document. Do you want to save them with the highlighting intact?
Q5. The postal codes appear to be for UK which has two basic formats (A[A]N[A/N] or A[A]N[A/N] NAA see https://en.wikipedia.org/wiki/List_of_postal_codes for details) is that correct?
Q6. Is the slightly different format in all cases that a space in the postal code is always replaced by a slash (/) or are there other differences?
Q7. What do you mean by 'there is potential for this to expand'? How could it expand?

FAO pbornemeier;4933406
Q1. Yes the files can be opened in Excel and they are in a tabular nature rather than like a text document.
Q2. I would like to highlight by changing the colour and making it bold, or if possible highlight the text in some way to make it obvious.
Q3. The name of the file is quite convoluted and as I am at home and the file is at work, I cannot remember the name.
Q4. I would like to save the file with the highlighting intact.
Q5 & Q6. Some of the postcodes contain just the first part of the postcode others may contain the first part followed by a (/) and the first digit of the second part as in your example above.
Q7. As this is going to be a job that may be undertaken every month or so the files in question although they will contain the same data in the same format my vary by length.

TIA

 

[pbornemeier]

Q8: When the data is imported into Excel are the postal codes you are looking for part of the contents of a cell or will they always be the only text in a cell?

 

[pbornemeier]

Try this on a copy of your data. The modified workbooks will have to be saved manually.

Option Explicit

Sub FindPostalCodes()

    'Examine each visible workbook open in this instance of Excel (except for the one containing
    '  this code) for the postal codes listed starting in A3 and down (no blank cells) of the
    '  'Codes' worksheet in this workbook.  When a match is found tint the cells containing one
    '  or more codes yellow.  Color the code characters red and underline them.  I am not sure if
    '  Excel will preserve the coloring when the wprkbook is saved.
    
    'Note:  This code resets the cell color, font color when it is run.  If the imported data
    '  has text with those characteristics, those characteristics will be removed.
    
    'If you have multiple instances of the same postal code in the same cell then the second and
    '  subsequent codes will not be marked.  This can be remedied with additional code.
    
    Dim arySearchData() As Variant
    Dim lSearchIndex As Long
    Dim wbk As Workbook
    Dim wks As Worksheet
    Dim sCode As String
    Dim sNewCode As String
    Dim lCodePos As Long
    Dim lPos As Long
    Dim oFound As Object
    Dim lLen As Long
    Dim lCodeLen As Long
    Dim lStart As Long
    Dim sFirstAddr As String
    Dim aryUL As Variant
    
    'Copy postal codes to an array
    ThisWorkbook.Activate
    With Worksheets("Codes")
        ReDim Preserve arySearchData(1 To .Cells(.Rows.Count, 1).End(xlUp).Row - 2)
        For lSearchIndex = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
            arySearchData(lSearchIndex - 2) = Trim(.Cells(lSearchIndex, 1).Value)
        Next
    End With
    
    'If any codes contain a space, add a value to the array that replaces a space with a slash
    For lSearchIndex = LBound(arySearchData) To UBound(arySearchData)
        sCode = arySearchData(lSearchIndex)
        If InStr(sCode, " ") > 0 Then
            sCode = Replace(sCode, " ", "/")
            ReDim Preserve arySearchData(LBound(arySearchData) To UBound(arySearchData) + 1)
            arySearchData(UBound(arySearchData)) = sCode
        End If
    Next

    For Each wbk In Application.Workbooks
        If wbk.Name <> ThisWorkbook.Name And wbk.Windows(1).Visible = True Then
            For Each wks In wbk.Worksheets
                With wks.UsedRange
                    .Cells.Interior.Color = -4142
                    .Cells.Font.Underline = xlUnderlineStyleNone
                    .Cells.Font.Color = 1
                    For lSearchIndex = LBound(arySearchData) To UBound(arySearchData)
                        sCode = arySearchData(lSearchIndex)
                        lCodeLen = Len(sCode)
                    
                        Set oFound = .Find(What:=sCode, LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False)
                        If Not oFound Is Nothing Then
                            sFirstAddr = oFound.Address
                            Do
                                oFound.Interior.Color = 65535
                                lCodePos = InStr(oFound, sCode)
                                ReDim aryUL(1 To Len(oFound))
                                For lPos = 1 To Len(oFound)
                                    If oFound.Characters(lPos, 1).Font.Underline = xlUnderlineStyleSingle Then
                                        aryUL(lPos) = 1
                                    End If
                                    If lPos >= lCodePos And lPos < lCodePos + lCodeLen Then
                                        aryUL(lPos) = 1
                                    End If
                                    If aryUL(lPos) = 1 Then
                                        With oFound.Characters(Start:=lPos, Length:=1).Font
                                            .Color = 255
                                            .Underline = xlUnderlineStyleSingle
                                        End With
                                    End If
                                Next
                                Set oFound = .FindNext(oFound)
                            Loop While Not oFound Is Nothing And oFound.Address <> sFirstAddr
                        
                        End If
                    Next lSearchIndex
                End With
            Next wks
        End If 'wbk.name
    Next wbk
End Sub

 

[Chris Waller]

Phil,

The code above appears to be way more complex than I thought it would be. I have managed to borrow a laptop that contains the files in question. I will try it out later in the day and I will let you know how I get on.

Thanks very much for all your help on this. Whilst I was quite good at writing macros back in the days of Lotus Symphony, I have never quite got my head around using VBA to write macros.

 

[Chris Waller]

Phil,

Thanks for all your help so far with this problem, however I think it may need a couple of tweeks. Firstly and this does not matter so much, but the postcodes on the first spreadsheet don't neccesarily need to be highlighted. The postcodes on the second do need to be highlighted which it is doing in most senarios however, it is giving some spurious results. It looks as though it is only highlighting part of the code rather than looking at all the postcode.

 

[Chris Waller]

Phil,

The postcodes will be the only entry in the cell.

Thanks

Chris

 

[pbornemeier]

If the postcodes are the only thing in a cell I can simplify the code. Could they have any leading or trailing spaces?
Please provide a list of all of the postal codes on the first page and 4 or 5 of the strings on the second page that show only partial highlighting. The code should be highlighting character strings on all worksheets that match any character strings in A3 and down on the first page.

 

[Chris Waller]

Phil,

There are no leading or trailing spaces in the postcodes.
The first list of postcodes below is what we are trying to highlight in the second list.
Postcode
NE16 5
DN1
DN2
DN3
DN4
DN5
DN7
DN9 3
DN11 0
DH3 1
DN11 9
S63 6
S63 7
S64
PL1
N12
OX10
OX11
DN55
NE16 9
NE82
NE83
NE85
NE88
NE92
NE98
NE99
PL95
N3
NW7
BN20
BN21
BN22
BN23
NE11
NE16 3
NE16 4
NE8
BH12
BH13
BH14
BH15
BH17
BH18
DN12
DN6
DN8
L20
L21
L22
L23
L29
L30
L31
L37
L38
N2
NE10
NE9
PR8


This is what has been highlighted after the macro has been run. It appears that the macro has highlighted the N2 in the first 5 postcodes N3 in the next 4, L20 in the next 5, etc. I would attach a Word document to let you see what it is doing, but I don't think this is allowed.
Postcode
WN2/1
WN2/2
WN2/3
WN2/4
WN2/5
WN3/0
WN3/4
WN3/5
WN3/6
L20/0
L20/3
L20/4
L20/5
L20/6
L21
L22
L23
L29
L30
L31/0
L31/2
L31/3
L31/5
L31/6
L31/7
L31/8
L31/9
L37/1
L37/2
L37/3
L37/4
L37/6
L37/7
L37/8
L38
PR8/1
PR8/2
PR8/6
PR8/9
PR9/0
PR9/7
PR9/9
L31/1
L31/4
L37/0
L37/5
L37/9
PR8/3
PR8/4
PR8/5
PR9/8
L20/1
L20/2
L20/7
L20/8
L20/9

TIA

Chris