EXCEL: Combining Ranges and Collections 1

[marcus101]

Hello:

I'm currently working on an Excel 2003 Spreadsheet with VBA.

I'd like to do the following:

1. I have an array of data values for a range of cells.

2. I have a range of cell locations I'd like to copy the values to.

3. I'd like to check the array of data values so I can make sure that those values are
populated - ie: if they are zero, I want to ensure that those values are set to zero.

4. I also want to test for negative numeric values, so if a value is found to be negative, it can be multiplied by -1 to make it positive.

I'm not sure if I'm missing anything near the end of my code though. I'm trying to use a range and a collection to get things working, but I'm wondering if I should replace the collection with an array instead, so I can retrieve these values one at a time.

Here is a sample of my code, which is a work-in-progress:

Dim data_cells() as Variant
Dim data_range as Range
Dim sheet_Name as String
Dim rangeToCopy as Range

Dim int_cellcount As Integer
Dim intcounter As Integer
        
Dim n As Integer
Dim pasteVal As Variant

Dim resultList As Collection
Dim rlCount As Integer
Dim dataRange As Range
Dim cellInRange As Range

Dim resultVariant As Variant
Dim resultRange() As Integer 
                        
Dim dataRangeChk As Variant
Dim dataRowChk As Variant
Dim counter As Integer

' NOTE: My data cell values have already been initialized with a set batch of values.

' Get a count of the data_cells array..
int_cellcount = Application.CountA(data_cells)

' Process Ranges Based on Sheet Name..

Select Case sheet_Name

Case "Sheet1"

For Each cellInRange In rangeToCopy.Cells

cellValue = cellInRange.Value

' Check if the cell has a number
If Application.WorksheetFunction.IsNumber(cellValue) Then

' Test row value for cell checking
dataRangeChk = data_cells(cellInRange).Value
                        
Select Case Len(dataRangeChk)
                        
Case 5 ' 1 digit
dataRowChk = Right(data_cells(cellInRange), 1)
                            
Case 7 ' 2 digits
dataRowChk = Right(data_cells(cellInRange), 2)
                        
Case 9 ' 3 digits
dataRowChk = Right(data_cells(cellInRange), 3)
                        
End Select
                        
Select Case dataRowChk
                        
Case 1 - 15, 19 - 25, ' Covers fixed rows on Sheet

If cellValue < 0 Then
cellValue = cellValue * -1
resultList.Add cellValue
                                
ElseIf cellValue > 0 Then
resultList.Add cellValue
                                
Else
cellValue = 0
resultList.Add cellValue
                                
End If
                                
Case Else
                            
If cellValue > 0 Or cellValue < 0 Then
resultList.Add cellValue
                                
Else
cellValue = 0
resultList.Add cellValue
                                
End If
                        
End Select
                                         
End If
                   
Next cellInRange
            

' Select Destination Cells and Iteratively Paste
For n = 1 To intcounter
            
' Get the list value
pasteVal = dataRange(n).Value
            
' Select the destination cell
ActiveSheet.Range(data_cells(n)).Select
            
' Paste the value
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
Application.CutCopyMode = False
            
Next n

Case "Sheet2"
' similar code to Sheet1 but with different row/case logic

Case Else
' similar code to Sheet1 but with different row/case logic

End Select

Thanks in advance for any suggestions, thoughts, etc.


marcus101
Access/SQL/XML Developer
Ottawa, Canada

 

[SkipVought]

Hi,

Your code is VERY DIFFICULT to follow.

Please INDENT to identify Select Case blocks, For...Next blocks, If Then Else blocks, etc. and resubmit.

Skip,
[sub]
[red][/red]
[/sub]

 

[SkipVought]

...example...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.TopLeftCell.Address = Target.Address Then
            If shp.Visible Then
                shp.Visible = False
            Else
                shp.Visible = True
            End If
            
            Exit For
        End If
    Next
End Sub

Skip,
[sub]
[red][/red]
[/sub]

 

[PHV]

Have a look here:

http://www.oaltd.co.uk/Indenter/Default.htm

 

[SkipVought]

PHV -- way kewel! ==> *

Skip,
[sub]
[red][/red]
[/sub]