CODEWITHSUNDEEP
excelvba
Markus Sacramento
Markus Sacramento

Reputation: 364

Excel VBA strip string into another cell

I´m trying to create an Excelsheet that runs multiple VBA scripts after writing anything in A Column.

One part I would like some help with is that the character 2,3 and 4 written in A column (any row) should be written i D column same row. I also would like to remove any information i D Column if I remove the text from A Column.

enter image description here

I have manage to create a script that calls modules after writing information i a cell in A Column

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub
    Application.EnableEvents = False 'to prevent endless loop
    On Error GoTo Finalize 'to re-enable the events
    Call Modul1.Module
Finalize:
    Application.EnableEvents = True
End Sub

Any help would be much appriciated.

This is what I have for now. It doesn´t work to clear value on all rows only some of them?!

Sub Lokation()

Dim n As Long, i As Long, j As Long
n = Cells(Rows.Count, "A").End(xlUp).Row
j = 2
For i = 2 To n
    If Cells(i, "A").Value = vbNullString Then

    Cells(j, "D").Value = ("")

    Else

    Cells(j, "D").Value = Mid(Cells(j, "A").Value, 2, 3)

    End If
   j = j + 1
Next i
End Sub

Upvotes: 0

Views: 359

Answers (1)

CLR
CLR

Reputation: 12279

You can wrap this whole piece up in just the Worksheet_Change event if you use the following:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim columnAcell As Range

    If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    For Each columnAcell In Target.Cells
        columnAcell.Offset(0, 3) = Mid(columnAcell, 2, 3)
    Next

    Application.EnableEvents = True

End Sub

Instead of specifically writing to column D, I've used a cell offset of 3 columns from Target. As this code only looks at column A currently, it will always offset to column D.

Things to watch out for though -

  • Altering cell(A1) which contains the header would result in cell(D1) being altered. You can prevent this by changing the Intersect range from A:A to something like A2:Axxxx
  • Deleting the entirety of column A would result in the loop running for a very long time, not to mention causing column D to move to column C. You may want to prevent users from being able to do this.

Upvotes: 1

Related Questions