Delete item from array

sektor · April 8th, 2008, 08:07 AM

Apologizes gotta be taken 'cause I didn't use YOUR variant of Next, but I added my lngK variable to your code - thus, i didn't try your variant and ran my own "on-the-fly" ;)

tstav · April 8th, 2008, 08:54 AM

OkOkOk. Apologies accepted and everything's settled.

sektor · April 29th, 2008, 02:52 AM

And what about the same code, but with one extra dimension?

Dim vaTowns As Variant

With Sheets("data")
vaTowns = .Range(.Cells(rngRow.Row, "G"), _
.Cells(rngRow.Row, "G").End(xlDown)).Resize(, 2)
End With

I tried all my best, but resultless.

tstav · April 29th, 2008, 02:50 PM

In this case, use both dimensions of vaTowns:

Code:

Sub RemoveArrayDuplicates()
Dim vaTowns As Variant, vaTownsDistinct As Variant
Dim lngI As Long, lngK As Long

On Error Resume Next
With Sheets("data")
   vaTowns = .Range(.Cells(rngRow.Row, "G"), .Cells(rngRow.Row, "G").End(xlDown)).Resize(, 2)
End With

ReDim vaTownsDistinct(1 To 1)

vaTownsDistinct(1) = vaTowns(1, 1)
For lngI = LBound(vaTowns, 1) To UBound(vaTowns, 1) 'first dimension is number of rows

   For lngK = LBound(vaTowns, 2) To UBound(vaTowns, 2) 'second dimension is number of columns

      If WorksheetFunction.Match(vaTowns(lngI, lngK), vaTownsDistinct, 0) Then
         If Err Then 'no match
            Err.Clear
            ReDim Preserve vaTownsDistinct(1 To UBound(vaTownsDistinct) + 1)
            vaTownsDistinct(UBound(vaTownsDistinct)) = vaTowns(lngI, lngK)
         End If
      End If

   Next 'lngK

Next 'lngI

For lngK = 1 To UBound(vaTownsDistinct)
   Range("E2").Offset(lngK, 0).Value = vaTownsDistinct(lngK)
Next
End Sub

sektor · April 29th, 2008, 11:49 PM

OK. To get things clearer, let me write a full explanation of my code.
The thing is I get two columns: first column contains towns and second one contains their abbreviations. Looks like this:

            Column1 Column2
        ||========||======||
        || Towns || Abbr ||
        ||========||======||
Row1 || Voronezh || g ||
Row2 || Tambov || g ||
Row3 || Belgorod || g ||
etc.

Here's full code:

1. Define what happens if user double-clicks any cell in "I" column.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Intersect(Target, Columns("I")) Is Nothing Then
      Call AddDropDownTown(Target)
      Cancel = True
   End If
End Sub

2. When user double-clicks any cell in "I" column, then DropDown control appears in target cell.

Sub AddDropDownTown(Target As Range)

Dim ddown As DropDown
Dim sDistrict As String
Dim rngRow As Range
Dim vaTowns As Variant
Dim vaTownsMod() As Variant
Dim i As Long
Dim k As Long

On Error Resume Next

'Add DropDown control to Target cell
With Target
    Set ddown = Sheet1.DropDowns.Add(.Left, .Top, .Width, .Height)
End With

'Get name of district in neighbour cell
sDistrict = Left$(Target(1, 0), Len(Target(1, 0)) - 4)

With Sheet2
    Set rngRow = .Range("C:C").Find(What:=sDistrict) 'Row where range begins
    vaTowns = .Range(.Cells(rngRow.Row, "G"), _
                      .Cells(rngRow.Row, "G").End(xlDown)).Resize(, 2)
End With

'=== HERE'S YOUR CODE ====
ReDim vaTownsMod(1 To 1)

vaTownsMod(1) = vaTowns(1, 1)
For i = LBound(vaTowns, 1) To UBound(vaTowns, 1) 'first dimension is number of rows
   For k = LBound(vaTowns, 2) To UBound(vaTowns, 2) 'second dimension is number of columns
      If WorksheetFunction.Match(vaTowns(i, k), vaTownsMod, 0) Then
         If Err Then
            Err.Clear
            ReDim Preserve vaTownsMod(1 To UBound(vaTownsMod) + 1)
            vaTownsMod(UBound(vaTownsMod)) = vaTowns(i, k)
         End If
      End If
   Next
Next
'=== HERE'S YOUR CODE ====

'Define macro to run and fill DropDown
With ddown
    .DropDownLines = 20
    .OnAction = "TownName"
    .List = vaTownsMod 'This property fills DropDown, but some mess appears.
End With
End Sub

I wonder, what went wrong???

tstav · April 30th, 2008, 03:13 AM

Hi sektor,
first thing to do would be to comment out the On Error Resume Next code line. It is suppressing errors and probably misleads you.

sektor · April 30th, 2008, 04:36 AM

Quote:

quote:Originally posted by tstav
Hi sektor,
first thing to do would be to comment out the On Error Resume Next code line. It is suppressing errors and probably misleads you.

Yes, you was right! When i commented it out, error had appeared:
"Unable to get the Match property of the WorksheetFunction class".
My head is blown off! :)