VBA loop in change event error - vba

Question

I have this macro that creates a textbox in worksheet 2 when I write something in cell A1 of worksheet 1, and when I delete that value it deletes the textbox.
I want to do that for several cells, but it just is working. If Cell A1 has a value a textbox with that value should appear, if the A2 has a value a textbox with that value should appear, but if I delete A1 it should delete the texbox that refers to A1, not all of the textboxes
Sub RemoveShapes()
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox Then shp.Delete
Next shp
End Sub
Sub criarcaixastexto()
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)
box.TextFrame.Characters.Text = Range("Folha1!A1").value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Call criarcaixastexto
End If
End Sub
I tried this but it doesn't work
'macro para apagar
Sub removercaixas()
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox Then shp.Delete
Next shp
End Sub
'macro para criar caixas de texto
Sub criarcaixastexto()
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)
box.TextFrame.Characters.Text = Worksheets(1).Cells(i, 1).Value
End Sub
' macro corre ao escrever texto numa célula
Private Sub Worksheet_Change(ByVal Target As Range)
For i = 1 To 3
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A&i")) Is Nothing Then
removercaixas
If Len(Target) > 1 Then criarcaixastexto
End If
Next
End Sub

Answer 1

You are removing all textboxes on the sheet any time you call removercaixas. You need to somehow link the textbox with the cell it was generated by.
Why not name the textbox with the cell address? Copy/Paste this:
Sub removercaixas(strName As String)
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox AND shp.Name = strName Then shp.Delete
Next shp
End Sub
And
Sub criarcaixastexto(strName As String)
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)
box.TextFrame.Characters.Text = Worksheets(1).Range(strName).Value
box.Name = strName
End Sub
And
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Select Case Target.Address
Case "$A$1", "$A$2", "$A$3"
removercaixas (Target.Address)
Case Else
Exit Sub
End Select
If Len(Target) > 1 Then criarcaixastexto (Target.Address)
End Sub
Textboxes are created in worksheet 2 all on top of each other. They are deleted appropriately. No textbox is created when the value entered in $A$1:$A$3 has a length of 1 or less. Not sure what the logic is there, but if you want single digit values to create a textbox just change the Len(Target) > 1 to Len(Target) > 0.