Public LevelsRange As Range

sub GetData()
UserForm1.Show vbModeless
WaitForInput (UserForm1)
end sub

sub WaitForInput (frm as UserForm)
Do Until frm.Visible = False
    DoEvents
Loop
end sub

Sub Test()
    
    Dim IDCell As Range, EVCell As Range

    Set wsSource = ThisWorkbook.Sheets("TEST SHEET")

    Set ActivityIDCell = wsSource.Range(FindCell("Activity ID"))
    Set EVCell = wsSource.Range(FindCell("EARNED VALUE")) ' Ошибка возникает после второго раза запуска функции FindCell

End Sub

Function FindCell(CellContent As String)

    FindCell = wsSource.Cells.Find(CellContent, LookIn:=xlValues).Address

End Function

Sub writeA()
cells(1,1) = "A"
End Sub 

Dim CurrentColor As Integer
Const BLACK = 0, RED = 1, GREEN = 2, BLUE = 3

' Set the pen color property for a Drawing package.
' The module-level variable CurrentColor is set to
' a numeric value that identifies the color used for drawing.
Property Let PenColor(ColorName As String)
   Select Case ColorName   ' Check color name string.
      Case "Red"
         CurrentColor = RED   ' Assign value for Red.
      Case "Green"
         CurrentColor = GREEN   ' Assign value for Green.
      Case "Blue"
         CurrentColor = BLUE   ' Assign value for Blue.
      Case Else
         CurrentColor = BLACK   ' Assign default value.
   End Select
End Property

' The following code sets the PenColor property for a drawing package
' by calling the Property let procedure.

PenColor = "Red"
 

 ' Раздаю определенения
  Dim arr1 As New Collection, a1
  Dim aFirstArray1() As Variant
  Dim i1 As Long
 
' Присваиваю значения переменным. Т.к. данные на другой странице, использую WTIH
With Sheets("PROJECT DETAILS")
    LastRow1 = .Cells.Find("*", .Range("A1"), , , xlByRows, xlPrevious).Row
    PROJECTSLIST1 = .Range(.Cells(2, 1), .Cells(LastRow1, 1)).Value
End With
 
'Пытаюсь включить уникальные значения из списка "PROJECTSLIST1" в ListBox "ProjectsList" путём фильтрации через свойства Collection.
aFirstArray1() = PROJECTSLIST1
  On Error Resume Next
  For Each a1 In aFirstArray1
  arr1.Add a1, a1
  Next

  For Each a1 In arr1
     frm_PROJECTWISEREPORT.ProjectsList.AddItem arr1(a1)
  Next
End If

aFirstArray1() = PROJECTSLIST1
  On Error Resume Next
  For Each a1 In aFirstArray1
  arr1.Add a1, a1
  Next

Sub test()

For Each c In Range("A:A")
If c Like "A" Then
    CriteriaRow = c.Row
    Rows(CriteriaRow).Delete
End If
Next

End Sub

=INDEX($A$1:$A$25;MATCH(SMALL(IF(ISBLANK($A$1:$A$25);"";IF(ISNUMBER($A$1:$A$25);COUNTIF($A$1:$A$25;"<"&$A$1:$A$25);COUNTIF($A$1:$A$25;"<"&$A$1:$A$25)+SUM(IF(ISNUMBER($A$1:$A$25);1;0))+1));ROW()-ROW($A$1)+1);IF(ISBLANK($A$1:$A$25);"";IF(ISNUMBER($A$1:$A$25);COUNTIF($A$1:$A$25;"<"&$A$1:$A$25);COUNTIF($A$1:$A$25;"<"&$A$1:$A$25)+SUM(IF(ISNUMBER($A$1:$A$25);1;0))+1));0))