excel 2003 - vba - swap cell content

[silentbuddha]

Hi,

I am stuck on this particular problem...

Scenario: I have a simple column in my activeworksheet

Column A
---------
1 ( Cell 1,1 )
2 ( Cell 2,1 )
3 ( Cell 3,1 )
4 ( Cell 4,1 )
5 ( Cell 5,1 )

let us suppose the user changes the content in Cell(1,1) from 1 to 2 and now the column would look like :

Column A
---------
2 ( Cell 1,1 )
2 ( Cell 2,1 )
3 ( Cell 3,1 )
4 ( Cell 4,1 )
5 ( Cell 5,1 )

Question : how do I use vba to dynamically change Cell(2,1) content from 2 to 1 in order to keep all values in column A unique ???

Thanks !

 

[9ballpimp]

Ok, here you go. Just copy this code into a Sheet2 object (I used Sheet2 for this, but you can change it to whatever sheet you need).

Dim vOldVal 'Must be at top of module

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Dim c As Range
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
    With Application
         .ScreenUpdating = False
         .EnableEvents = False
    End With
Set myRange = Worksheets("Sheet2").Range("A1:A5")
rFnd = Application.WorksheetFunction.CountIf(myRange, Target)
If rFnd > 1 Then
    For Each c In myRange
        If Target.Address <> c.Address Then
        c.Replace What:=Target.Value, Replacement:=vOldVal, _
        LookAt:=xlWhole
        End If
    Next c
End If
    vOldVal = vbNullString
    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
On Error GoTo 0
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    vOldVal = Target
End Sub

Should work like a charm!

Troy

 

[silentbuddha]

Thanks Troy...I'm still a newb..i will first try to understand your code by following your instructions...

 

[silentbuddha]

Hi Troy,

I here is my final code...however..I have a bad feeling that I will be causing a continuous loop once the subroutine calls swapCellValue() .....not sure where I can break this loop or where i should be calling
swapCellValue

************************* CODE ***********************

Dim cellOldValue As Variant
Dim cellNewValue As Variant
Dim cellOldRange As String

************************* CODE ***********************
Private Sub Worksheet_Change(ByVal Target As Range)
'This procedure will check whether the user made a change in specific cell

Dim interSectRange As Range
'set the range
Set interSectRange = Range("B16:B1430")
Application.EnableEvents = False
'Check whether active cell is within a specified range, if not then do nothing
If Intersect(Target, interSectRange) Is Nothing Then
' code to handle that the active cell is not within the right range
MsgBox "Active Cell not in Range!"
Application.EnableEvents = True
Exit Sub
Else
' code to handle when the active cell is within the right range
MsgBox "Active Cell In Range!"
Application.EnableEvents = True
'Exit Sub
End If

'Do nothing if more than one cell is changed or content deleted
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

'Ensure target cell value is a number
If IsNumeric(Target) Then
MsgBox "Value entered is a number!"
Application.EnableEvents = True
'Exit Sub
Else
MsgBox "value entered is not a number, please verify!"
Application.EnableEvents = True
Exit Sub
End If

'Check whether target cell address is valid before calling swapCells subroutine
If (Target.Row - Range("B16").Row) Mod 14 = 0 Then
MsgBox "The cell you have selected is allowed!"
cellNewValue = Target.Value
MsgBox " old value is " & cellOldValue
MsgBox " old cell address is " & cellOldRange
MsgBox " new value is " & cellNewValue
Application.EnableEvents = True
'Call swapCellValue
Exit Sub
Else
MsgBox "the cell you have selected is not allowed!"
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End Sub

************************* CODE ***********************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'this code will store the old cell value before change is made by user

cellOldValue = ActiveCell.Value
cellOldRange = ActiveCell.Address

End Sub

 

[9ballpimp]

Well, there's a couple of things...

First, this code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'this code will store the old cell value before change is made by user

cellOldValue = ActiveCell.Value
cellOldRange = ActiveCell.Address

End Sub

really isn't necessary (you should leave it as it was), as once you define something is equal to Target, then you should pull out the .Value and .Address once your within the other sub, not in here. It just causes confusion.

Second, why are you calling another sub, instead of doing it in here? That may also cause confusion, and needing to declare additional things you don't need to.

Third, have you tested this yet? Why do you think it will cause an infinite loop? Put it in a test workbook, and try it, then post back your exact findings.

Troy

 

[silentbuddha]

Hi Troy,

Thanks for all your help.....in the end here is what my code looks like. Definitely, not as elegant as your original solution, but outcome will be the same.

Thanks once again...your code really gave me some inspiration !

Keith

********************** CODE *************************

Dim cellOldValue As Variant
Dim cellNewValue As Variant
Dim cellOldRange As String

********************** CODE *************************

Private Sub Worksheet_Change(ByVal Target As Range)
'This procedure will check whether the user made a change in specific cell

Dim interSectRange As Range

'set the range

Set interSectRange = Range("B16:B1430")

Application.EnableEvents = False

'Check whether active cell is within a specified range, if not then do nothing
If Intersect(Target, interSectRange) Is Nothing Then

' code to handle that the active cell is not within the right range

MsgBox "Active Cell not in Range!"

Application.EnableEvents = True

Exit Sub

Else

' code to handle when the active cell is within the right range

MsgBox "Active Cell In Range!"

Application.EnableEvents = True

'Exit Sub

End If

'Do nothing if more than one cell is changed or content deleted
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

'Ensure target cell value is a number
If IsNumeric(Target) Then

MsgBox "Value entered is a number!"

Application.EnableEvents = True

'Exit Sub

Else

MsgBox "value entered is not a number, please verify!"

Application.EnableEvents = True

Exit Sub

End If

'Check whether target cell address is valid before calling swapCells subroutine
If (Target.Row - Range("B16").Row) Mod 14 = 0 Then

MsgBox "The cell you have selected is allowed!"

cellNewValue = Target.Value

MsgBox " old value is " & cellOldValue

MsgBox " old cell address is " & cellOldRange

MsgBox " new value is " & cellNewValue

Application.EnableEvents = True

Call swapCellValue

'Exit Sub

Else

MsgBox "the cell you have selected is not allowed!"

Application.EnableEvents = True

Exit Sub

End If

Application.EnableEvents = True

End Sub

********************** CODE *************************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'this code will store the old cell value before change is made by user

cellOldValue = ActiveCell.Value

cellOldRange = ActiveCell.Address

End Sub

********************** CODE *************************

Private Sub swapCellValue()

MsgBox " subroutine swapCellValue was called "

Dim c As Range
Dim kpiRange As Range
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ActiveWorkbook

Set ws = wb.Worksheets("Main")

Set kpiRange = ws.Range("B16:B1430")

For Each c In kpiRange

If (cellOldRange <> c.Address) And (cellNewValue = c.Value) Then

MsgBox " match found at " & c.Address & " with rank : " & c.Value

Exit Sub

End If

Next c

cellOldValue = vbNullString

End Sub

*********************** END OF CODE ********************

 

[silentbuddha]

Hi Troy,

In your original code....how do you avoid the coninuous loop

Thanks !

 

[9ballpimp]

It avoids a continuous loop because you're starting with 5 cells which are NOT duplicative. That helps, because you don't have to worry about the original list not having a previous value to change a duplicative cell to.

And while it's in the sub, it skips over the cell which the change was made, which will avoid a loop there.

Hope that helps!

Troy