EXCEL: Process Cell Ranges w/ Collections (REPOST) 1

[marcus101]

Hello:

This is a repost of my previous code. My apologies if things were unclear. I have used the indenting tool as well as cleaned things up and commented more extensively as to what I am trying to accomplish.

I am running into the occasional sub-scripting error with this. I am not sure if this is because I am trying to do something that the collection can't really do very well.

Maybe it would be better for me to use another array to process the values instead of a collection.

My primary problem is that when I paste the values into my spreadsheet from the array I get blanks where I have zero values, and seeing as I need to assess numbers and multiply them in certain cases anyway, I thought I could take care of two problems at the same time.

Take a look at the revised code sample below for more details.

Sub ProcessRangeCells()

    Dim n As Integer
    Dim counter As Integer

    Dim dest_cells() As Variant
    Dim pasteVal As Variant

    Dim resultList As Collection
    ' rlCount not used but could be with resultList.Count   
    Dim rlCount As Integer  

    Dim cellInRange As Range

    Dim dataRangeChk As Variant
    Dim dataRowChk As Variant

    ' Step A. Setup Cell Array/Range to be Copied/Processed

    ' dest_cells() = Array of fixed points on my
    ' spreadsheet where I wish to paste copied
    ' cell range values to

    dest_cells() = Array("D11:E11", "D13:E13", "D14:E14", "D16:E16", "D19:E19", "D25:E25")

    ' Internal processing of cells to be copied into
    ' rangeToCopy, which acts as source range of data cells

    Dim beginRangeCell As Range
    Set beginRangeCell = Worksheets(1).Cells(intmaxrow + 2, intmaxcolumn - 2)

    Dim endRangeCell As Range
    Set endRangeCell = Worksheets(1).Cells(intmaxrow + 2, intmaxcolumn)

    Dim rangeToCopy As Range
    Set rangeToCopy = Worksheets(1).Range(beginRangeCell, endRangeCell)

    rangeToCopy.Select
    Selection.Copy

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

    ' Step B. Process the Cell Range and add to a
    ' separate/parallel Collection of Values

    ' The idea of this is to do the following:

    ' B1. Iterate through ALL cells in the range, one at
    ' a time, and assess each numeric value so that it
    ' is retained or changed, and copied into a new
    ' separate collection that can  be copied into the
    ' cell address locations contained in dest_cells().

    ' B2. I've also included some code that checks the
    ' comparable destination array value and isolates it
    ' so that I check the destination row value.

    ' I am accomplishing this by measuring the length
    ' of the cell address string:

    ' B2a) The cell address string is always a two value 
    ' range index and does not go beyond column Z,

    ' B2b) I then use the RIGHT function to capture the
    ' last 1-3 digits to get the row value.
    ' The rows are fixed and never go beyond 3 digits.

    ' B3. I then get the value of the cell from the 
    ' captured/copied range above in Step A.

    ' If the value of the cell is blank, or zero, ensure
    ' that the value remains set at zero.
    ' If the value of the cell is less than zero, 
    ' multiply by -1.
    ' If the value is greater than zero, then retain
    ' the value and leave as-is.

    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 via 
            ' dataRowChk (below)
            dataRangeChk = dest_cells(cellInRange).Value

            Select Case Len(dataRangeChk)
           ' Captures dest_cells() sheet Row value

                Case 5    ' 1 digit
                    dataRowChk = Right(dest_cells(cellInRange), 1)

                Case 7    ' 2 digits
                    dataRowChk = Right(dest_cells(cellInRange), 2)

                Case 9    ' 3 digits
                    dataRowChk = Right(dest_cells(cellInRange), 3)

            End Select

            Select Case dataRowChk

                ' Covers fixed Sheet Rows
                Case 1 - 15, 19 - 25

                    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

    ' Step C. Select the Destination Cells using
    ' dest_cells Array and Paste Values from the
    ' Collection created in Step B (above)

    ' Select Destination Cells and Iteratively Paste
    For n = 1 To intcounter

        ' Get the list value
        pasteVal = resultList(n).Value

        ' Select the destination cell
        ActiveSheet.Range(dest_cells(n)).Select

        ' Paste the value
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        Application.CutCopyMode = False

    Next n

End Sub

Thanks in advance for any suggestions, ideas, etc.


marcus101
Access/SQL/XML Developer
Ottawa, Canada

 

[SkipVought]

For one thing do not use an array for your dest, rather...

    Dim dest_cells As Range
    Set dest_cells = Union(Range("D11:E11"), Range("D13:E13"), Range("D14:E14"), Range("D16:E16"), Range("D19:E19"), Range("D25:E25"))
    dest_cells.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

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

 

[SkipVought]

...also in the last for next

    For n = 1 To intcounter
[b]
        ' COPY the list value
        resultList(n).Copy[/b]

        ' Paste the value multiple places
        [b]dest_cells[/b].PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Next n
    Application.CutCopyMode = False

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

 

[marcus101]

Hi Skip:

Thanks for the suggestion.

I don't see what this does other than making my array of cells a range. If this makes the paste operation work better, then great.

It's a bit problematic because in my application, I don't just have one set array of cells but multiple sets I have to process, so I guess I may have to change them all to ranges... :-(

I also need to make changes to the cell data that will go into the dest_cells array values, and so that could mean using some sort of collection or list, which I am not sure will even work or not. I am still trying things out to see what will work well (if at all).

Maybe I'm making this more complicated than it needs to be, but other than doing post-paste iterative cell checking on fixed cell values for the negative values, I can't see any other way to do a check on what I'm copying from.

I was trying to limit the number of times I iterate through cells, as each time I create a loop and iterate, everything takes longer, even with screen updating turned off.

I see one problem lies in my copying component in Step C. This is missing something.

At the moment, I see no way that I have in my code sample that gets the pasteVal values into the dest_cell array or range addresses.

I will keep you posted.

Thanks again.



marcus101
Access/SQL/XML Developer
Ottawa, Canada

 

[marcus101]

Skip:

OK! I hope the copy part works. I will put this all together and try it out.

Thanks,

marcus101
Access/SQL/XML Developer
Ottawa, Canada

 

[marcus101]

Skip:

Before I try this, just curious:

Here is the code you used:

For n = 1 To intcounter

        ' COPY the list value
        resultList(n).Copy

        ' Paste the value multiple places
        [b]dest_cells[/b].PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Next n
    [b]Application.CutCopyMode = False[/b]

How does the dest_cells Range know which individual cell value to copy to? Does it automatically iterate?

This is why I used an array to begin with, so I could match the data with the destination cell values.

And I also noticed you moved the Application.CutCopyMode line OUTSIDE of the loop, after "Next n".

Is this because of the need to iteratively paste one value at a time that you have done that, or should this line stay INSIDE the loop?

Thanks,


marcus101
Access/SQL/XML Developer
Ottawa, Canada

 

[SkipVought]

I see that I overlooked what you are doing in step B

There is a difference between ASSIGNING a value to a variable and COPYING a range. You cannot PASTE from an assigned value. You COPY TO the clipboard and PASTE FROM the clipboard. That's why there is, "...no way that I have in my code sample that gets the pasteVal values into the dest_cell array..."

The FROM stuff, needs to be a range, just as the TO (dest_cells) needs to be a range.

I'd look at ONE LOOP, setting the FROM RANGE, Copy the FROM range, Paste Special to the TO range.

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

 

[marcus101]

Skip:

I understand where you are coming from. What you say makes sense.

But my new question becomes:

How do you ASSESS and CHANGE a RANGE's values in the FROM RANGE loop?

I'll do some searching in this forum and see what I can come up with.

Thanks again.

marcus101
Access/SQL/XML Developer
Ottawa, Canada

 

[SkipVought]

Depends on the requirements, but, for instance...

For n = 1 To intcounter

    select case SomeCriteriaThanChangesWith[b]n[/b]
      case 1
        set FromRange = WhateverItIsFor_1
        set ToRange = WhateverThatIsFor_1
      case 2
        set FromRange = WhateverItIsFor_2
        set ToRange = WhateverThatIsFor_2
'......... and so on
    end select  
 
    FromRange.COpy

    ToRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next n

'and finally.....
Set FromRange = Nothing
Set ToRange = Nothing
End Sub

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