Consulting

Results 1 to 3 of 3

Thread: Solved: load a one dimensional array from non-contiguo

  1. #1

    Solved: load a one dimensional array from non-contiguo

    Hi there,

    I am embarrased to say I have been wracking my brain on this simple problem for 2 days without success. I am trying to place all values searched for, and found, into a one dimensional Array, then list the contents of the array in a specified range on the same worksheet. Is this possible, being that the cells found are non-contiguous, or in random locations?

    [VBA]Option Explicit
    Sub FindExcess()
    Dim Total As Long
    Dim c As Range
    Dim FirstAddress As String
    Dim ToFind As String

    ToFind = InputBox("Text to find", "Custom Search", "excess")
    With ActiveSheet.Cells
    Set c = .Find(ToFind, LookIn:=xlValues)
    If Not c Is Nothing Then
    FirstAddress = c.Address
    Do
    Total = Total + c.Offset(, -1)
    Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> FirstAddress
    End If
    End With
    MsgBox Total
    End Sub[/VBA]

  2. #2
    Mac Moderator VBAX Guru mikerickson's Avatar
    Joined
    May 2007
    Location
    Davis CA
    Posts
    2,778
    Something like this should work.
    [VBA]Sub FindExcess2()
    Dim Total As Long
    Dim c As Range
    Dim FirstAddress As String
    Dim ToFind As String

    Dim myArray As Variant, pointer As Long
    Dim writeToRange As Range
    Set writeToRange = ActiveSheet.Range("G1")

    ToFind = InputBox("Text to find", "Custom Search", "excess")
    If ToFind = vbNullString Then Exit Sub: Rem cancel pressed

    With ActiveSheet.UsedRange.Offset(0, 1)
    ReDim myArray(1 To .Cells.Count)

    Set c = .Find(ToFind, LookIn:=xlValues)

    If Not c Is Nothing Then
    FirstAddress = c.Address

    Do
    pointer = pointer + 1
    myArray(pointer) = c.Offset(0, -1)
    Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> FirstAddress

    ReDim Preserve myArray(1 To pointer)
    writeToRange.Resize(UBound(myArray), 1).Value = Application.Transpose(myArray)

    End If

    Total = Application.SumIf(.Cells, ToFind, .Cells.Offset(0, -1))
    End With

    MsgBox Total

    End Sub[/VBA]

  3. #3
    A-m-a-z-i-n-g!!!

    Thank you much!!! Would you be able to recommend any good books or sites that will allow me to one day reach your level?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •