Arrays and other general coding help.

[shelfish]

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)

 

[sbmack7]

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

 

[sbmack7]

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

 

[shelfish]

Thank you. That is much simpler. However I am working on a very large
project and I have to this about 30 times. That's why I'm trying to
get it into an array that I can pass to a function. There are times
that I am looking to delete entries not on the compare list and times
that I need to delete entries that are on the compare list, hence the
long but descriptive variable "toDelete_uniquesT_OR_duplicatesF"

At this point I would have to go back and change the structure of my
code to do what you have laid out. Although I'm sure that needs to be
done, I have to have this done by Monday. So, my goal is to get that
function working...accepting arrays and modifying them and giving them
back.

Thanks,
S.

 

[sbmack7]

Thank you. That is much simpler. However I am working on a very large
project and I have to this about 30 times. That's why I'm trying to
get it into an array that I can pass to a function. There are times
that I am looking to delete entries not on the compare list and times
that I need to delete entries that are on the compare list, hence the
long but descriptive variable "toDelete_uniquesT_OR_duplicatesF"

At this point I would have to go back and change the structure of my
code to do what you have laid out. Although I'm sure that needs to be
done, I have to have this done by Monday. So, my goal is to get that
function working...accepting arrays and modifying them and giving them
back.

Thanks,
S.

Shelfish,

I don't know that you will have revisited this forum before Monday.
But I just want to invite you not to make your life more complicated
than it has to be. You mention using a function instead of a
subroutine. That is confusing because a function returns a single
value. While it seems that you want to act on a range of values.

The little subroutine that I wrote will operate on any range. So
rather than passing an array to your complex subroutin, you could pass
a range replacing the conVals range in mine. You would disaggregate
the problem by assembling the proper range in an external subroutine
that then calls CompVals.

But of course, you understand your problem completely. While I'm just
taking a stab at a technique that could help you. So whatever works
from your point of view.

Good luck,

SteveM