Hi,

I have a list in column C.

In column J i'm using xl mid function to calculate a middle value in
column C.


Column C:
89111000111112
89111000111113
89111000111114
89111000111115
89111000111116
89111000111117
89111000111118

Column J: (using xl mid function)
001
001
001
001
001
001
001

The formula is dragged in column J to the last value in column C to
have the result.
I would like to have this formula in VB to claculate the same so that
there would be no need to drag the formula each time column C values
are changed.


Thx.

Hi Sinner

The code below would be one way to do it, though it will all depend on
if your numbers in column C being the same length. Also i added an
apostrophe to the start of the value in column J to stop it from
changing to show "1" and dropping the leading 00. This can be removed
from the code by deleting "'" & from the code.

Paste this code into the module for the sheet you want the code to
run.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 3 Then

Cells(Target.Row, 10).Value = "'" & Mid(Target.Value, 7, 3)

End If

End Sub

Hope this helps

Steve

Hi Steve,

J1 also changed : ). The values start 2nd row in column C i.e. C2 so
it should start from J2. First one is header.

Thx.


On Feb 21, 5:49*pm, Incidental wrote:
Hi Sinner

The code below would be one way to do it, though it will all depend on
if your numbers in column C being the same length. *Also i added an
apostrophe to the start of the value in column J to stop it from
changing to show "1" and dropping the leading 00. *This can be removed
from the code by deleting "'" & from the code.

Paste this code into the module for the sheet you want the code to
run.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 3 Then

* * Cells(Target.Row, 10).Value = "'" & Mid(Target.Value, 7, 3)

End If

End Sub

Hope this helps

Steve

When I select entire list in column C and clear or paste, it gives a
run-time error. type miss match.
Any idea??

Thx.

On Feb 21, 6:42*pm, Sinner wrote:
Hi Steve,

J1 also changed : ). The values start 2nd row in column C i.e. C2 so
it should start from J2. First one is header.

Thx.

On Feb 21, 5:49*pm, Incidental wrote:



Hi Sinner

The code below would be one way to do it, though it will all depend on
if your numbers in column C being the same length. *Also i added an
apostrophe to the start of the value in column J to stop it from
changing to show "1" and dropping the leading 00. *This can be removed
from the code by deleting "'" & from the code.

Paste this code into the module for the sheet you want the code to
run.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 3 Then

* * Cells(Target.Row, 10).Value = "'" & Mid(Target.Value, 7, 3)

End If

End Sub

Hope this helps

Steve- Hide quoted text -

- Show quoted text -

Hi Sinner

Sorry i should have thought, this should keep it right

If Target.Count = 1 Then

If Target.Column = 3 Then

If Target.Row < 1 Then

Cells(Target.Row, 10).Value = "'" & Mid(Target.Value, 7, 3)

End If

End If

End If

Steve

Steve when I select more than one cell and press delete, the contents
in C are cleared but values in J don't seem to disappear.
Any idea?


Thx.

On Feb 21, 7:47*pm, Incidental wrote:
Hi Sinner

Sorry i should have thought, this should keep it right

If Target.Count = 1 Then

* * If Target.Column = 3 Then

* * * * If Target.Row < 1 Then

* * * * Cells(Target.Row, 10).Value = "'" & Mid(Target.Value, 7, 3)

* * * * End If

* * End If

End If

Steve

Hi Sinner

I'm not sure why that is happening as if I delete a value in column C
the value in column J is also removed. Did you change the code to fit
your needs or are you using the exact code I posted? Let me know
either way or post your code and I will have a look. I have changed
the code I posted earlier just to make it a little cleaner, I removed
one of the "If" statements as it was unnecessary.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 Then

If Target.Column = 3 And Target.Row < 1 Then

Cells(Target.Row, 10).Value = "'" & Mid(Target.Value, 7, 3)

End If

End If

End Sub

Steve

On Feb 22, 3:07*pm, Incidental wrote:
Hi Sinner

I'm not sure why that is happening as if I delete a value in column C
the value in column J is also removed. *Did you change the code to fit
your needs or are you using the exact code I posted? *Let me know
either way or post your code and I will have a look. *I have changed
the code I posted earlier just to make it a little cleaner, I removed
one of the "If" statements as it was unnecessary.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 Then

* * If Target.Column = 3 And Target.Row < 1 Then

* * * * Cells(Target.Row, 10).Value = "'" & Mid(Target.Value, 7, 3)

* * End If

End If

End Sub

Steve

Hi Steve,

I have already removed the extra if : )

You wrote:
"I'm not sure why that is happening as if I delete a value in column C
the value in column J is also removed."
For single value select it is working fine.
For more than one selection the code is unable to remove the value in
J.
For instance you select C114 & delete, then it is working but if you
select C114, C115, C116, C117 and delete, then values in corresponding
column J114, J115, J116 & J117 are not removed.

My guess is that Target.Count needs to be varied with selection of
cells.

My code is below.
---------------------
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 Then

If Target.Column = 3 And Target.Row < 1 Then

Cells(Target.Row, 10).Value = Mid(Target.Value, 10, 3)

End If

End If


End Sub
---------------------------------

Thx.

Hi

Sorry i misunderstood what you were trying to do. I have modified the
code and pasted below, you were right about using target.count but
since we have already checked it we can simply add an "else" statement
to the existing "if" statement. Then all i did was replace the column
letters in the range to show J instead of C and then clear that
range. This seems to work fine unless you filldown or paste a single
value into the full highlighted range then the J column will be
cleared i am thinking you could get round this by testing the value of
the first cell in the range for "" or something.

Option Explicit
Dim SwitchColumn As String

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 Then

If Target.Column = 3 And Target.Row < 1 Then

Cells(Target.Row, 10).Value = "'" & Mid(Target.Value, 7, 3)

End If

Else

If Target.Column = 3 And Target.Row < 1 Then

SwitchColumn = Replace(Target.Address, "C", "J")

Range(SwitchColumn).Clear

End If

End If

Let me know how you get on

Steve