On May 31, 4:08 pm, sbma...@comcast.net wrote:
> On May 31, 3:07 pm, shelfish <shelf...@gmail.com> wrote:
>
>
>
> > Hi,
>
> > I'm running into several errors while using arrays in every way I know
> > how. I've tried doing it as md arrays and paramArrays, etc. and can't
> > seem to make it work. I've searched the NG and while there has been a
> > lot of helpful offerings, nothing seems to work. I'm trying to compare
> > a column of constant values to one of varying values and delete those
> > not found on the constant list. See code below and note that I use the
> > array "a()" throughout my code like most people "i" - as a counter. It
> > gets reused for different purposes over and over.
>
> > "**********************************************************
> > 'All declarations are in a global area... not in any sub or function
> > Option Base 1
> > Dim lastRow As Integer
> > Dim i As Long
> > Dim a() As Variant 'TEMPORARY USE ARRAY
> > '**************************************************************
> > Sub Sub1()
> > ReDim a(2)
> > a(1) = Array(lastRow - 1) 'VERIFIED VALUE OF LASTROW AT 306
> > For i = 1 To lastRow
> > a(1)(i) = Trim(ActiveSheet.Cells(1, 1).Offset(i, 0).Value)
> > 'THROWS ERROR ON i = 2.
> > Next i
>
> > 'REPEAT FOR A SECOND COLUMN AND ASSIGN ARRAY TO a(2)....lastRow =
> > 3402
>
> > If compareDeleteArrays(a(2), a(1), True) Then 'FUNCTION DEFINED BELOW
>
> > For i = 1 To lastRow 'NEED A MORE EFFICIENT WAY TO
> > If a(2)(i) = Empty Then 'DELETE THE ROWS MARKED BY THE
> > FUNCTION
> > Cells(1, 1).Offset(i, 0) = "x"
> > Else
> > Cells(1, 1).Offset(i, 0).Value = b(i)
> > End If
> > Next
> > For i = 1 To lastRow
> > If Cells(1, 1).Offset(i, 0) = "x" Then Cells(1, 1).Offset(i,
> > 0).EntireRow.Delete
> > Next
>
> > End If
> > End Sub
> > '*********************************************************************
> > 'I'M TRYING TO MAKE THIS FAIRLY UNIVERSAL FOR REUSE, SO FEEL FREE TO
> > POINT OUT ALL THE MISTAKES...glutton for punishment
>
> > 'RETURNS BOOLEAN FOR SUCCESSFUL OR NOT
> > Function compareDeleteArrays(deleteArray As Variant, _
> > compareArray As Variant,
> > _
>
> > toDelete_uniquesT_OR_duplicatesF As Boolean) As Boolean
>
> > 'CAN I GRAB THE ARRAYS BY REF/VAL AND CHANGE THEIR VALUE GLOBALLY
> > WITHOUT HAVING TO PASS THEM BACK.
>
> > Dim d As Long 'to enum the deleteArray()
> > Dim c As Long ' to enum the compareArray()
> > Dim dCount As Long
> > Dim cCount As Long 'number of elements in each array
>
> > 'VALIDATE ARGUMENTS
> > If TypeName(deleteArray) <> "Variant ()" Then GoTo Failure
> > If TypeName(compareArray) <> "Variant ()" Then GoTo Failure
>
> > 'CHECK FOR DIMENSIONS...code not written yet.
>
> > 'Set function to failure unless it makes it to the last line
> > compareDeleteArrays = False
>
> > dCount = UBound(deleteArray, 1) - LBound(deleteArray, 1) + 1
> > cCount = UBound(compareArray, 1) - LBound(compareArray, 1) + 1
>
> > 'SET ENUMS
> > For d = 1 To dCount
>
> > For c = 1 To cCount
> > If deleteArray(d) = compareArray(c) Then Exit For
> > Next cCount
>
> > If c <= cCount Then 'must have exited early
>
> > 'If deleting duplicates
> > If toDelete_uniquesT_OR_duplicatesF = False Then
> > deleteArray(d) = Empty
>
> > Else: Exit For 'Else must be deleting
> > uniques
> > End If
>
> > Else 'must have no duplicates with this d
> > If toDelete_uniquesT_OR_duplicatesF = True Then
> > deleteArray(d) = Empty
> > End If
> > End If
>
> > Next dCount
>
> > compareDeleteArrays = True
>
> > 'HOW DO I ALSO PASS BACK THE NEW ARRAY IN THE SAVE VARIABLE
> > "a(2)" ...RETURN TWO THINGS FROM ONE FUNCTION
>
> > 'GOTO
> > Failure:
> > End Function
> > '************************************************************************
>
> > God bless the person who takes on this mess. And thanks for any and
> > all help.
>
> > =NEWB(Shelton)
>
> Shelton,
>
> You are right. That IS a mess. You don't even need to use arrays.
> Here is a simple solution using two For Each Loops:
>
> Assume conVals and varVals are named Ranges of your value vectors
>
> Sub CompareVals()
> Dim cell1 As Range, cell2 As Range
> Dim conRange As Range, varRange As Range
> Dim valMatch As Boolean
>
> Set conRange = Range("conVals")
> Set varRange = Range("varVals")
>
> For Each cell1 In varRange
> valMatch = False
> For Each cell2 In conRange
> MsgBox cell1 & " " & cell2
> If cell1 = cell2 Then
> valMatch = True
> Exit For
> End If
> Next
> If Not valMatch Then
> cell1 = ""
> End If
> Next
>
> End Sub
>
> SteveM
p.s. the message box was a test. zotz out that line
|
Similar Threads
