VBA Building An Array (I think) of different items

[Lotus Cars]

Hi all,

I have two columns, one with numbers that could be individual, could be duplicate on another row. The second either has entries in, or is blank.

ie

8945
8946 identified
9405 identified
8945
1575

What I want is to go down the second column, identify the blanks, and put them into an individual array. However, if the number is duplicate, then I only want it once.

I'd got this far...


Dim blanks As String
Dim empties As String


Range("O2").Select
blanks = "Missing Project Numbers - "
Do
If ActiveCell = "" Then
n = 1
Do
If empties = "" Then empties = ActiveCell.Offset(0, -11)
n = n + 1
Loop Until empties = ActiveCell.Offset(0, -11)


End If

ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Offset(0, -10) = ""
Range("A1").Select

but it does not like putting a number against empties to create the unique string / array.

Any ideas?

Cheers,

Lotus Cars

 

[Lotus Cars]

Sorry, got some of my coding wrong, but still have the same problem. Any help would be appreciated.

Sub anothercheckbalnks()
Dim blanks As String
Dim empties As String
Dim n As Integer

Range("O2").Select
blanks = "Missing Project Numbers - "
Do
If ActiveCell = "" Then
n = 1
Do
If empties = "" Then empties = ActiveCell.Offset(0, -11)
n = n + 1
Loop Until empties = ActiveCell.Offset(0, -11)
End If
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Offset(0, -10) = ""

n = 1
Do
blanks = blanks & empties & ", "
n = n + 1
Loop Until empties = ""
If blanks <> "Missing Project Numbers - " Then MsgBox blanks
End Sub



Cheers,

Lotus Cars

 

[DauntingGecko]

Name your data (2 columns by many rows) myData

Option Explicit
Option Base 1

Sub myExample()
Dim myArray As Variant
Dim Numbers As Variant
Dim i As Double

On Error GoTo err


    ' First, sort the data in the spreadsheet by numbers (faster than VBA)
    [myData].Sort Key1:=Range([myData].End(xlToLeft).Offset(0, 1).Address), Order1:=xlAscending
    
    myArray = [myData] ' this is my named range (data)
    ReDim Numbers(1)
    
    ' Get the list of IDs / numbers that are not flagged
    For i = LBound(myArray) To UBound(myArray)
        If myArray(i, 2) = "" Then
            If UBound(Numbers) = 1 And Numbers(1) = "" Then
                Numbers(1) = myArray(i, 1)
            Else
                ReDim Preserve Numbers(UBound(Numbers) + 1)
                Numbers(UBound(Numbers)) = myArray(i, 1)
            End If
        End If
    Next i
    
    Erase myArray
    ReDim myArray(1)
    
    ' Time to remove duplicates
    For i = LBound(Numbers) To UBound(Numbers)
        If i = UBound(Numbers) Then
            If UBound(myArray) = 1 And myArray(1) = "" Then
                myArray(1) = Numbers(i)
            Else
                ReDim Preserve myArray(UBound(myArray) + 1)
                myArray(UBound(myArray)) = Numbers(i)
            End If
        Else
            If Numbers(i) <> Numbers(i + 1) Then
                If UBound(myArray) = 1 And myArray(1) = "" Then
                    myArray(1) = Numbers(i)
                Else
                    ReDim Preserve myArray(UBound(myArray) + 1)
                    myArray(UBound(myArray)) = Numbers(i)
                End If
            End If
        End If
    Next i
    Erase Numbers
    
    MsgBox "Complete"
    
    ' myArray has all the values you need in it

Exit Sub

err:
    MsgBox err.Description, vbExclamation, "Error"

End Sub

P.S. I'll have an Exige please.

 

[Lotus Cars]

Cheers for your help - it does seem a bit complicated to follow, but it did seem to work.

I'll do my best for the car!