Need dictionary/loop assistance

Question

I have some work to complete where I have 9 tabs of data (some of which contain thousands of lines of data). Each tab contains (amongst others) a policy number, a credit and/or a debit number.

Every policy number will have a match somewhere in the tabs containing an equal credit or debit, e.g.

tab 1 will have Policy number 123 and a credit of £100 and
tab 5 will also have policy number 123 with a debit of £100.

What I'm looking to do is, look through each policy number on every tab and find where the opposite amount is located adding the location address to each policy number.

I'm certainly not looking for anyone to create the coding for me, but what I am looking for is advice. I've looked at using loops but feel this may take a very long time to process. I've also looked at Dictionaries but am relatively new to these so am not very confident.

Is what I'm looking for even possible? And if so any ideas where to start or pointers? Any advice is greatly appreciated. Thanks!

You could use a loop for looping through rows of tab 1 and [WorksheetFunction.Match Method](https://msdn.microsoft.com/en-us/library/office/ff835873.aspx) or [Range.Find Method](https://msdn.microsoft.com/en-us/library/office/ff839746.aspx) to see if there are matches in the other tabs for the current row. Also sorting by policy number can shorten loops a lot. — Pᴇʜ, Jun 20 '17 at 08:38
Why not just use the vba `Find` function. You'd be able to search against all the policy numbers that match (if there is more then one debit/credit against a policy number etc.) — Tom, Jun 20 '17 at 08:40
When you say tab, do you mean column? What does the data look like in this case (give an example)? — Vegard, Jun 20 '17 at 09:00
@Peh, That worksheetfunction.match method is spot on! I'm tinkering with the code but it looks like it'll do what I want! — Matt555, Jun 20 '17 at 09:38

T.M. · Answer 1 · 2017-06-20T13:50:58.217

You could

a) create an XML file looping through all sheets,

b) open it via load method and

c) perform a simple XPath search (I can give some examples later)

I modified a recent answer (cf. excel-vba-xml-parsing-performance) to do step "a)" using late binding thus a) avoiding a reference to the latest MS XML Version Version 6 (msxml6.dll) and b) getting data over all xheets. XML allows you structured search via XPath over nodes in a logical structure comparable to HTML. The root node in this example is called data, the following nodes are named with the sheets' names and the subsequent nodes get the names in row A:A of each sheet.

A XML file is a simple text file, which you can open by a text editor. Above all you can use VBA XMLDOM methods to analyze or search through the items (nodes). I will give you examples to relating to your question, but give me some time. => see answer "Usage Example", where I explain some Advantages of XML, too (@Peh).

Please pay Attention to the added notes, too.

Option Explicit

Sub xmlExportSheets()
' Zweck: XML Export over all sheets in workbook
' cf. Site:  [excel-vba-xml-parsing-performance][1][https://stackoverflow.com/questions/40986395/excel-vba-xml-parsing-performance/40987237#40987237][1]
' Note:  pretty printed raw output with line breaks and indentation using an embedded XSLT stylesheet
On Error GoTo ErrHandle
' A. Declarations
' 1  DECLARE XML DOC OBJECT '
' a) Early Binding: VBA REFERENCE MSXML, v6.0 necessary'
'    Dim doc      As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60
'    Dim root     As IXMLDOMElement, dataNode As IXMLDOMElement, datesNode As IXMLDOMElement, namesNode As IXMLDOMElement
' b) Late Binding XML Files:
  Dim doc       As Object
  Dim xslDoc    As Object
  Dim newDoc    As Object
' c) Late Binding XML Nodes:
  Dim root      As Object
  Dim sh        As Object   ' xml node containing Sheet Name
  Dim dataNode  As Object
  Dim datesNode As Object
  Dim namesnode As Object

' 2   DECLARE   other variables
  Dim i         As Long
  Dim j         As Long
  Dim tmpValue  As Variant
  Dim tit       As String
  Dim ws        As Worksheet

' B.  XML Docs to Memory
  Set doc = CreateObject("MSXML2.Domdocument.6.0")
  Set xslDoc = CreateObject("MSXML2.Domdocument.6.0")
  Set newDoc = CreateObject("MSXML2.Domdocument.6.0")

' C.  Set DocumentElement (= root node)'
  Set root = doc.createElement("data")
' D.  Create Root Node
  doc.appendChild root


' ===========================
' ITERATE THROUGH Sheets
' ===========================
For Each ws In ThisWorkbook.Sheets
    Set sh = doc.createElement(ws.Name)     '
    root.appendChild sh

  ' ===========================
  ' ITERATE THROUGH ROWS                              ' A2:NNn
  ' ===========================
  For i = 2 To ws.UsedRange.Rows.Count                ' Sheets(1)

    ' DATA ROW NODE '
    Set dataNode = doc.createElement("row")     '
    sh.appendChild dataNode

    ' TABLES NODE (orig.: DATES NODE) '
    Set datesNode = doc.createElement(ws.Cells(1, 1))     ' Dates
    datesNode.Text = ws.Range("A" & i)
    dataNode.appendChild datesNode

    ' NAMES NODE '
    For j = 1 To ws.UsedRange.Columns.Count - 1 ' = 12
        tit = ws.Cells(1, j + 1)
        tmpValue = ws.Cells(i, j + 1)
            Set namesnode = doc.createElement(tit)
            namesnode.Text = tmpValue
            dataNode.appendChild namesnode
    Next j

  Next i

Next ws

' =============================
' PRETTY PRINT RAW OUTPUT (XSL)
' =============================
  xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
        & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
        & "                xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
        & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
        & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
        & "            encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
        & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _
        & "  <xsl:copy>" _
        & "   <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _
        & "  </xsl:copy>" _
        & " </xsl:template>" _
        & "</xsl:stylesheet>"
' XSLT (Transformation)
  xslDoc.async = False
  doc.transformNodeToObject xslDoc, newDoc
' =================
' Save the XML File
' =================
  newDoc.Save ThisWorkbook.Path & "\Output.xml"

  MsgBox "Successfully exported Excel data to " & ThisWorkbook.Path & "\Output.XML!", vbInformation
' Regular End of procedure
  Exit Sub

 ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
  Exit Sub

End Sub

Note

Sheet names have to be without spaces

Added Note (important hint): XML Nodes use titles in first row of every sheet. As the modified procedure gets title names via UsedRange it's important not to have any empty cells in row A:A for this example.

Additional remark I don't know the reason why my prompt answer (marked as "a") was downgraded by someone. I would find it helpful to argue this :-)

Just for my personal interest: I've never seen an approach like this before (for finding matching data within different sheets). It would be nice if you could explain in your answer *why* this approach with XML is an advantage (or at least why you choose it) over the more obvious approach of using *match* or *find* because it looks really cumbersome and not really transparent to me. — Pᴇʜ, Jun 20 '17 at 11:50
@Peh, You are right, xml dom methods aren't used too often within vba. The advantage of using XML in this connex is a great flexibility in searching via XPath as well as performance over huge files. I prefer it even to arrays or dictionaries when filtering unique values. It is possible to return the found item number in node lists without looping through the whole data set ... — T.M., Jun 20 '17 at 15:09

score 0 · Answer 2 · answered Jun 20 '17 at 12:40

Usage Example

@Matt555, You can test the created XML file with the following code to get the sheet names of policy "123" and debit of 100. I tested the code assuming your titles in row A:A contain "policy" and "debit"

@Peh, You are right, xml dom methods aren't used too often within vba. The advantage of using XML in this connex is a great flexibility in searching via XPath as well as performance over huge files. I prefer it even to arrays or dictionaries when filtering unique values. It is possible to return the found item number in node lists without looping through the whole data set ...

Option Explicit
Sub testPolicy()
   Dim policy
   Dim debit As Double

   policy = "123"
   debit = "100"

   MsgBox "Policy " & policy & " found in " & vbNewLine & _
          findSheetName(policy, debit), vbInformation, "Policy " & policy & " in Tabs"
   ' You can easily split this to an array and analyze the results
End Sub


Function findSheetName(ByVal policy, Optional ByVal debit) As String
' Purpose: Finds Sheet Names where policy AND/OR debit is found
' Note:    Assuming your titles in row A:A contain "policy" and "debit"
'          You can declare xDoc also after Option Explicit to make it public
Dim xDoc    As Object
Dim xNd     As Object ' MSXML.IXMDOMNode
Dim xNdList As Object ' MSXML.IXMLDOMNodeList
Dim s     As String
' XPath expression
Dim xPth  As String

If IsMissing(debit) Then
    xPth = "//row[policy=""" & policy & """]"
Else
    xPth = "//row[policy=""" & policy & """][debit=""" & debit & """]"
End If

' XML to memory
Set xDoc = CreateObject("MSXML2.Domdocument.6.0")
' allow XPath
xDoc.setProperty "SelectionLanguage", "XPath"
xDoc.validateOnParse = False
' ========
' LOAD XML
' ========
xDoc.Load ThisWorkbook.Path & "\" & "output.xml"

' Loop thru NodeList
Set xNdList = xDoc.DocumentElement.SelectNodes(xPth)
Debug.Print xPth, xNdList.Length
For Each xNd In xNdList
    s = s & xNd.ParentNode.NodeName & "|"
Next xNd

Set xDoc = Nothing

findSheetName = s
End Function

Need dictionary/loop assistance

2 Answers2