Columns Selected Array

[Steven M. Britton]

I'm having some issues with trying to get this code to work properly. What
this is trying to do is record changes made to the columns containing the
Part Number, Qty and Unit Cost. I had it working fine if the user only
changed one cell at a time, I was able to pick up the row/column and produce
the change.

The issue is that if the user selects a range and deletes it or drag and
drop or xlFillDown, I can't figure out how to record it properly - however
I'm getting close. My main issue right now is I want to only build the array
if the range contains the columns I am interested in AND build the array of
just those columns. Example, if the user selects Cells.Select in the upper
left most corner of the spreadsheet the workbook goes "nuts" while it builds
an array of (1 to 65536, 1 to 256) this is bad...

How do I use the intersect or some other range type function to build and
array of the columns I'm interested in? That should send me into the right
direction I hope...

Thanks,

-Steven M. Britton

Here is the code:

Option Explicit

Public varPriorRange As Variant
Public varAddr As Variant
Public varStartColumn As Variant
Public varCount As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strSheet As String
Dim strCellValue As String
Dim varTargetAddress As Variant
Dim varCurrentRange As Variant
Dim r As Long
Dim x As Long
Dim y As Long
Dim lngRow As Long
Dim lngCol As Long


Application.ScreenUpdating = False
strSheet = ActiveSheet.Name

If Target.Column = 17 Or Target.Column = 18 Or Target.Column = 19 Then

strCellValue = Worksheets("2005").Cells(2, 1).Value

If Target.Count = 1 Then
If Target.Count = 1 And varCount = 1 Then
varTargetAddress = Right(Target.Address,
InStr(StrReverse(Target.Address), "$") - 1)
varAddr = Right(varAddr, InStr(StrReverse(varAddr), "$") - 1)
Else
varTargetAddress = Right(Target.Address,
InStr(StrReverse(Target.Address), "$") - 1)
varAddr = Mid(varAddr, 4, InStr(1, varAddr, ":", vbTextCompare)
- 4)
End If

x = (varTargetAddress - varAddr) + 1
y = (Target.Column - varStartColumn) + 1

If IsNull(strCellValue) = True Or strCellValue = "" Then

Worksheets("2005").Cells(2, 1).Value = Application.UserName
Worksheets("2005").Cells(2, 2).Value = Date & " " & Time
Worksheets("2005").Cells(2, 3).Value = varPriorRange(x, y)
Worksheets("2005").Cells(2, 4).Value = Target.Text
Else

Sheets("2005").Select
ActiveSheet.Cells(1, 1).Select
Selection.End(xlDown).Select
r = ActiveCell.Row + 1

Worksheets("2005").Cells(r, 1).Value = Application.UserName
Worksheets("2005").Cells(r, 2).Value = Date & " " & Time
Worksheets("2005").Cells(r, 3).Value = varPriorRange(x, y)
Worksheets("2005").Cells(r, 4).Value = Target.Text

End If

Else
lngRow = UBound(varPriorRange, 1)
lngCol = UBound(varPriorRange, 2)

varCurrentRange = Target.FormulaR1C1

If IsNull(strCellValue) = True Or strCellValue = "" Then

r = 2

For x = 1 To lngRow
For y = 1 To lngCol
If varPriorRange(x, y) <> "" Or varCurrentRange(x, y) <>
"" Then
Worksheets("2005").Cells(r, 1).Value =
Application.UserName
Worksheets("2005").Cells(r, 2).Value = Date & " " & Time
Worksheets("2005").Cells(r, 3).Value = varPriorRange(x, y)
Worksheets("2005").Cells(r, 4).Value =
varCurrentRange(x, y)
r = r + 1
End If
Next
Next
Else

Sheets("2005").Select
ActiveSheet.Cells(1, 1).Select
Selection.End(xlDown).Select
r = ActiveCell.Row + 1

For x = 1 To lngRow
For y = 1 To lngCol
If varPriorRange(x, y) <> "" Or varCurrentRange(x, y) <>
"" Then
Worksheets("2005").Cells(r, 1).Value =
Application.UserName
Worksheets("2005").Cells(r, 2).Value = Date & " " & Time
Worksheets("2005").Cells(r, 3).Value = varPriorRange(x, y)
Worksheets("2005").Cells(r, 4).Value =
varCurrentRange(x, y)
r = r + 1
End If
Next
Next

End If

End If

End If

Sheets(strSheet).Select
Application.ScreenUpdating = True

End Sub

Public Sub Worksheet_SelectionChange(ByVal Target As Range)

varPriorRange = Target.FormulaR1C1
varAddr = Target.Address
varStartColumn = Target.Column
varCount = Target.Count

End Sub