5 digit numbers where the sum is equal to 18

Brute force approach:

Sub List18s()
   Dim a As Long, b As Long, c As Long, d As Long, e As Long
   Dim lngCount As Long
   Dim varOut()
   ReDim varOut(1 To 99000)
   For a = 0 To 9
      For b = 0 To 9
         For c = 0 To 9
            For d = 0 To 9
               For e = 0 To 9
                  If a + b + c + d + e = 18 Then
                     lngCount = lngCount + 1
                     varOut(lngCount) = CLng(a & b & c & d & e)
                  End If
               Next e
            Next d
         Next c
      Next b
   Next a
   ReDim Preserve varOut(1 To lngCount)
   Range("A1").Resize(lngCount).Value = Application.Transpose(varOut)
End Sub