Find Existing String in 2-D Array

Question

I'm collecting data from a spreadsheet and storing it in a 2-D Array, the idea is that once the script detects it's reading from a specific column, it would not read an entire row of the data (as this would be considered a duplicate).

CODE:

Private Sub LoadData()

   cDOC_DEBUG "Loading document data..."
   Dim x As Long  'Column Data - there is another function that reads when x = 0 = header; else every other value is considered "data"
   Dim y As Long 

   With dataWS
      For x = 1 To LR - 1
         For y = 1 To LC - 1
            If (IsInArray(.Cells(x + 1, y + 1).value, pData())) Then
               cDOC_DEBUG "Added: " & .Cells(x + 1, y + 1).value
               pData(x, y) = Trim(.Cells(x + 1, y + 1).value)
            End If
         Next y
      Next x
   End With

End Sub

Private Function IsInArray(stringToBeFound As String, arrString As Variant) As Boolean
   IsInArray = (UBound(Filter(arrString, stringToBeFound)) > -1)
End Function

Private Sub cDOC_DEBUG(debugText As String)
   If (ThisWorkbook.Worksheets("Settings").Cells(3, 2)) Then
      Debug.Print debugText
   End If
End Sub

Everything is loading into the array fine, until I start implementing my IsInArray function. I can see it has to do with the fact that it's searching through a single dimensional array, and my array is two dimensional; so it makes sense that it's getting a type mismatch error.

Each row within the spreadsheet is a segment of information that correlates to it's self.

Initial Data From Spreadsheet:

        A           B           C           D
1    header1     header2     header3     header4
2       a           b           c           d
3       w           x           y           z
4       a           h           j           j
5       a           b           j           d
6       w           x           u           z

2x2 Final Array:

        0           1           2           3
0    header1     header2     header3     header4
1       a           b           c           d
2       w           x           y           z
3       a           h           j           j

Because Header1 & Header2 & Header4 from Excel rows 5 & 6 have the same values as Excel rows 2 and 3, this will not be read into the array.

Question:

How would I match the criteria above to not include the duplicates from a row.

Example Sudo Code:

If (Value being added matches all values from column Header1 & Header2 & Header3_ Then

Don't add to array

Another issue that I am aware of, is that there will be blank data within this array; is there something I can do to either 1 remove these or will I have to have another index for the array slots to keep track of?

QHarr · Accepted Answer

You can loop rows/columns and use Index to slice a row/column out of the array and use Match to test if search value is in that column. Combine with Count to test for duplicates. If the count equals the number of columns ignore value (or column count -1... see next comment ==>). Not entirely sure about this imaginary column. Do you intend to dimension at start with an additional empty column?

Row Versions:

Exists:

Option Explicit
Public Sub CheckRow()
    Dim arr(), i As Long
    arr = [A1:D6].Value                          '<==2D array created

    For i = LBound(arr, 1) To UBound(arr, 1)     '<== loop rows
        'look in each row for x and if found exit loop and indicate row where found
        If Not IsError(Application.Match("x", Application.WorksheetFunction.Index(arr, i, 0), 0)) Then
            Debug.Print "value found in column " & i
            Exit For
        End If
    Next
End Sub

Duplicates:

Option Explicit
Public Sub CheckRow()
    Dim arr(), i As Long
    arr = [A1:D6].Value                          '<==2D array created

    For i = LBound(arr, 1) To UBound(arr, 1)     '<== loop rows
        'look in each row for more than one "B" and if found exit loop and indicate row where found
         If Application.Count(Application.Match(Application.WorksheetFunction.Index(arr, i, 0), "B", 0)) > 1 Then
            Debug.Print i
            Exit For
        End If
    Next
End Sub

exists:

Columns versions:

Exists:

Option Explicit
Public Sub CheckColumn()
    Dim arr(), i As Long
    arr = [A1:D6].Value                          '<==2D array created

    For i = LBound(arr, 2) To UBound(arr, 2)     '<== loop columns
        'look in each column for x and if found exit loop and indicate column where found
        If Not IsError(Application.Match("x", Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, i)), 0)) Then
            Debug.Print "value found in column " & i
            Exit For
        End If
    Next
End Sub

Duplicates:

You can use Count to check for duplicates within an entire column, again sliced with Index:

Option Explicit
Public Sub CheckColumn()
    Dim arr(), i As Long
    arr = [A1:D6].Value                          '<==2D array created

    For i = LBound(arr, 2) To UBound(arr, 2)     '<== loop columns
        'look in each column for more than one "B" and if found exit loop and indicate column where found
         If Application.Count(Application.Match(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, i)), "B", 0)) > 1 Then
            Debug.Print i
            Exit For
        End If
    Next
End Sub

Using sample data in sheet:

Find Existing String in 2-D Array

Answers (2)

Related Questions