Array Problem

[Guest]

I am having trouble with this program and I think it is something minor...It
scans the first column in the sheet "Data" and returns unique values to be
stored in an array "PlayerNum".


Private Sub CommandButton1_Click()
Dim PlayerNum() As Variant
Dim x As Integer
Dim i As Integer

ChDir "C:\Documents and Settings\Scott Miller\My Documents\Handicap"
Workbooks.Open Filename:= _
"C:\Documents and Settings\Scott Miller\My
Documents\Handicap\Data.xls"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Handicap.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Windows("Data.xls").Activate
ActiveWindow.Close
Windows("Handicap.xls").Activate
Sheets("Data").Select

x = 3
i = 1
PlayerNum(i).Value = Sheets("Data").Cells(2, 1).Value

Do
Sheets("Data").Cells(x, 1).Select
If ActiveCell.Value = PlayerNum(i).Value Then
x = x + 1
Else
i = i + 1
ReDim Preserve PlayerNum(i) As Variant
PlayerNum(i).Value = ActiveCell.Value
End If

Loop Until Cells(x, 1).Value = ""


End Sub

Scott Miller
University of Washington
Chemistry

 

[Dave Peterson]

First, I'm gonna guess that this is code from a commandbutton from the control
toolbox toolbar placed on a worksheet.

If that's the case, then you have a few unqualified range objects. And since
they're not qualified, they belong to the worksheet that holds the code (the
worksheet with the commandbutton).

This would cause errors when you try to select a range on a sheet that wasn't
active--and opening a workbook would make the worksheet that's active in that
workbook the activesheet.

Because I'm confused about what ranges belong to what sheets/workbooks, this
suggested code may not work as you intended. But I think you'll be able to
modify it pretty easily.

I also don't like selecting stuff and activating windows. Selecting stuff
usually makes the code more difficult to read and slower to run. And activating
a window relies on the correct worksheet being active--and that might not happen
all the time.

Heck, if there are multiple windows into that workbook, the windows().activate
may not even work correctly.

I didn't test this, but it did compile ok.

Option Explicit
Private Sub CommandButton1_Click()

Dim PlayerNum() As Variant

Dim ImportWks As Worksheet
Dim ImportWkbkName As String
Dim ImportWksName As String

Dim RngToCopy As Range
Dim LastRow As Long
Dim LastCol As Long

Dim DataWks As Worksheet
Dim myRng As Range
Dim myCell As Range

'integers have no advantage over longs
'and longs have many advantages over integers
'number of rows in a worksheet for example.
Dim i As Long

Set DataWks = Me.Parent.Worksheets("Data")
'or just
'Set DataWks = Me
'if the button was on the Data worksheet

'It might be easier to just have a variable for each string.
'then when/if they change, you just have to change it once.
ImportWkbkName = "C:\Documents and Settings\Scott Miller" _
& "\My Documents\Handicap\Data.xls"
ImportWksName = "Sheet1" '<-- change the name here

Set ImportWks = Nothing
On Error Resume Next
Set ImportWks = Workbooks.Open(Filename:=ImportWkbkName, ReadOnly:=True) _
.Worksheets(ImportWksName)
On Error GoTo 0

If ImportWks Is Nothing Then
MsgBox "Design error--contact Scott!"
Exit Sub
End If

With ImportWks
'I used the data in column A to find the last row
'and the data in row 1 to find the last column
'this may need to be changed for your data
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set RngToCopy = .Range("a1", .Cells(LastRow, LastCol))

'clean up existing data?
DataWks.Cells.ClearContents
'me means the worksheet that holds the code

RngToCopy.Copy _
Destination:=DataWks.Range("a1")

'close the workbook that was just opened
.Parent.Close savechanges:=False

End With

With DataWks
'start in A2
Set myRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

i = 0
For Each myCell In myRng.Cells
If IsEmpty(myCell.Value) Then
'do nothing -- just in case??
Else
i = i + 1
ReDim Preserve PlayerNum(1 To i)
PlayerNum(i) = myCell.Value
End If
Next myCell
End With

'just to show you the results...
If i = 0 Then
MsgBox "something very bad happened."
Else
For i = LBound(PlayerNum) To UBound(PlayerNum)
MsgBox PlayerNum(i)
Next i
End If

End Sub

By the way, this doesn't insure unique values in that array--they'll only be
unique if the range you copied/pasted was a unique list.

If you really wanted a unique list, John Walkenbach has some sample code that
you could use:
http://j-walk.com/ss/excel/tips/tip47.htm

 

[Guest]

You certainly answered the question! I will have to reformulate the question
to get the answer to what is currently the trouble. Lost of great stuff in
the code though. i thank you for your time.

 

[Dave Peterson]

Instead of reformulating the question, you may want to look to see if there's
anything in that code that would solve the underlying question.

 

[Guest]

I rewrote the question... Dialogbox use Pivot or Array Forms?
I am working on the array logic more then anything else, eventually i can
get it to run but I have only been working in vba for a week now so I am
really confused about a ton of this stuff. I would look through the previous
posts but it is so hard to find anything that directly applies.