Errors dumping an Array to a range in a table

[gsmcconville]

Good evening.

I have been trying for a few days to find out why I get incorrect results trying to dump an array to a table.

When I dump the same array to an area outside of the table everything works fine.

Is this another but in Excel?

What I am trying to achieve is to have the end user right click on a Selection of Cells in a column, and then have the macro toggle a "Y". There cannot be a Y in both the Markdown and Stock Action, it has to be one or the other, or none at all.

There is a large amount of data to process over, so I wanted to load the data to an array, process the changes, and then dump it back onto the spreadsheet.

This is the code, but you will need to check out the attached spreadsheet to see it in action.

At the moment, it seems to add Y's where there should not be any and vice versa.


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Arr() As Variant, Rng As Range

If Target.Columns.Count > 1 Then Exit Sub

If Target.Column = 1 Or Target.Column = 5 Then ' Column 1 is in the table, Column 5 is not
Col1 = 1
Col2 = 2
Set Rng = Target.Resize(ColumnSize:=2)

ElseIf Target.Column = 2 Or Target.Column = 6 Then ' Column 2 is in the table, Column 6 is not
Set Rng = Target.Offset(ColumnOffset:=-1).Resize(ColumnSize:=2)
Col1 = 2
Col2 = 1

Else
Exit Sub

End If

Arr = Rng
RowIndex = 1

For Each Row In Rng.Rows
If Not Row.Hidden Then
If Trim(UCase(Arr(RowIndex, Col1))) = "Y" Or Trim(UCase(Arr(RowIndex, Col1))) = "YES" Then
Arr(RowIndex, Col1) = ""
Arr(RowIndex, Col2) = ""
Else
Arr(RowIndex, Col1) = "Y"
Arr(RowIndex, Col2) = ""
End If
End If
RowIndex = RowIndex + 1
Next

Rng = Arr
Sheet1.Range("A60:B" & UBound(Arr) - LBound(Arr) + 61) = Arr
Cancel = True
End Sub

[snb]

1. Always use row 1 and column A
2. select A1:A55
3. rightclick


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ReDim sn(1 To Target.Rows.Count, 1 To 2)

For Each cl In Target.SpecialCells(12).SpecialCells(2, 2)
If UCase(Left(cl, 1)) = "Y" Then sn(cl.Row, cl.Column) = "Y"
Next

Cells(60, 1).Resize(UBound(sn), 2) = sn
Cancel = True
End Sub

[gsmcconville]

1. Always use row 1 and column A
2. select A1:A55
3. rightclick


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ReDim sn(1 To Target.Rows.Count, 1 To 2)

For Each cl In Target.SpecialCells(12).SpecialCells(2, 2)
If UCase(Left(cl, 1)) = "Y" Then sn(cl.Row, cl.Column) = "Y"
Next

Cells(60, 1).Resize(UBound(sn), 2) = sn
Cancel = True
End Sub

This does not put the data into the table.

Sorry if I am missing something here, but I don't see how this relates to the question.

[gsmcconville]

I have been doing some further debugging with this, and I have found that it I fill a table with number and dates, and type each value separately, then it seems to work fine.
But if I fill in the values of the first two cells and then drag the cells to auto fill down the column, then it stops working.

It is like the values of the table are using the cell above itself to determine the correct value, and failing.

I am guessing this is another excel bug, and that it will not be solved. Interested to hear other peoples opinions on this.

[Paul_Hossler]

I didn't understand the reason behind wanting to make an array, and some things seem more complicated than they needed to be





Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim rData As Range, rCell As Range

Set rData = Intersect(Target, Range("A:B"))

If rData Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.ShowSelectionFloaties = False

Cancel = True

For Each rCell In rData.Cells
With rCell
If .Column = 1 Then
If .Value = "Y" Then
.ClearContents
.Offset(0, 1).Value = "Y"
ElseIf Len(.Value) = 0 Then
.Value = "Y"
.Offset(0, 1).ClearContents
End If
ElseIf .Column = 2 Then
If .Value = "Y" Then
.ClearContents
.Offset(0, -1).Value = "Y"
ElseIf Len(.Value) = 0 Then
.Value = "Y"
.Offset(0, -1).ClearContents
End If
End If
End With
Next
Application.ShowSelectionFloaties = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

[Aflatoon]

It is a bug. It occurs when the table is filtered. When you use the Rng = Arr statement, the array is actually truncated to fit the first visible area of the filtered table, and then that array is pasted into each area.