Tiedon siirtoa solusta kommenttikenttään

Tavalliseen moduliin seuraava rivi:
Public Edellinen

Työkirjan moduliin:

Private Sub Workbook_Open()
   Edellinen = Worksheets("Taul1").Range("P4")
End Sub

Taul1:n moduliin seuraavat:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Not Intersect(Target, Range("P4")) Is Nothing Then
      Edellinen = Target.Value
   End If
End Sub
' ----
Private Sub Worksheet_Change(ByVal Target As Range)
   Application.EnableEvents = False
   If Not Intersect(Target, Range("P4")) Is Nothing Then
      On Error Resume Next
      Range("A1").Comment.Delete
      On Error GoTo Täysi
      Range("A2:A2000").SpecialCells(xlCellTypeBlanks).Select
      ActiveCell = Edellinen
      Range("A1").AddComment.Text (Edellinen)
      Target.Offset(1, 0).Range("A1").Select
   End If
   Application.EnableEvents = True
Exit Sub
Täysi:
   Application.EnableEvents = True
   Target.Offset(1, 0).Range("A1").Select
   MsgBox ("Kaikki rivit täynnä!" & Chr(13) _
         & "Edellinen arvo oli:" & Chr(13) & Edellinen)
End Sub
'----

Minulla tosin tuo haku ei jostain käsittämättömästä syystä löydä tyhjiä rivejä enää rivin 22 jälkeen. Miten muilla? Missähän on vika?

Kiitos Tämmöselle, yritin rakentaa ohjeesi mukaan. En onnistunut, tein varmaan jotain väärin.
Siksi kysynkin tarkennusta..

Tuleeko tämä tarkasti ottaen minkä alle -moduuliin?
>>Tavalliseen moduliin seuraava rivi:
>>Public Edellinen

Tämä siis "Tämä työkirja" moduuliin.
>>Private Sub Workbook_Open()
>>Edellinen = Worksheets("Taul1").Range("P4")
>>End Sub


Tämä selkeästi siis Taul1 moduuliin.
>>Taul1:n moduliin seuraavat:
>>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>>If Not Intersect(Target, Range("P4")) Is Nothing Then
>>Edellinen = Target.Value
>>End If
>>End Sub

>>' ----

>>Private Sub Worksheet_Change(ByVal Target As Range)
>>Application.EnableEvents = False
>>If Not Intersect(Target, Range("P4")) Is Nothing Then
>>On Error Resume Next
>>Range("A1").Comment.Delete
>>On Error GoTo Täysi
>>Range("A2:A2000").SpecialCells(xlCellTypeBlanks).Select
>>ActiveCell = Edellinen
>> Range("A1").AddComment.Text (Edellinen)
>>Target.Offset(1, 0).Range("A1").Select
>>End If
>>Application.EnableEvents = True
>>Exit Sub
>>Täysi:
>>Application.EnableEvents = True
>>Target.Offset(1, 0).Range("A1").Select
>>MsgBox ("Kaikki rivit täynnä!" & Chr(13) _
>>& "Edellinen arvo oli:" & Chr(13) & Edellinen)
>>End Sub

Tavalliseen moduliin tulee ainoastaan muuttujan Edellinen esittely. Tarvitaan, jotta se pysyy muistissa. Molemmat makrot tulevat Taul1:n moduliin.
Jos kopioit tästä tekstiä, joka toinen rivi on tyhjä. Tarpeettomat pitää siivota pois. Ainakaan jatkuvan rivin (alaviivaan päättyvän) jälkeen ei saa olla tyhjää riviä.

Aikani tuhertaessani sain aikaan sen, että vain A1 -soluun tuli lisäkommenttikenttä(punakolmio) ja sinne solun P4 sisältö. Seuraavat P4 -solun sisällöt tulivat ilman kommenttikenttää ja loppuivat riville 24, eli viimeisin tuli A24 soluun. Siihen loppui tuotto mulla.

Oli siis tarkoitus, että solun P4 uusi sisältö siirtyisi napin- tai enterin painalluksella A-sarakkeelle aina ensimmäisen tyhjän solun kommenttikenttään, eli muodostaisi kommenttikentän (sen punakolmion) sinne soluun ja tieto sisään.

Tämä etsii tyhjan solun silmukalla:

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.EnableEvents = False
   If Not Intersect(Target, Range("P4")) Is Nothing Then
      For r = 2 To 2000
         If Cells(r, 1) = "" Then
            On Error Resume Next
            Range("A1").Comment.Delete
            On Error GoTo Err
            Range("A1").AddComment.Text (Edellinen)
            Cells(r, 1) = Edellinen
            Exit For
         End If
         If r = 2000 Then
            MsgBox ("Kaikki rivit täynnä!" & Chr(13) _
            & "Edellinen arvo oli:" & Chr(13) & Edellinen)
         End If
      Next r
   End If
Err:
   Application.EnableEvents = True
End Sub

Sarake A päivittyy aina kun soluun P4 kirjoitetaan uusi arvo (ja painetaan enteriä tai poistutaan solusta). Nappia ei tarvitse painaa. Jos toiminnan haluaa nappiin, sen ohjelmaan tulee sama ohjelmanpätkä ilman ehtoa If Not Intersect...

Kokeilin tätä viimeisintä Taul1 moduliin, muihin moduleihin en laittanut mitään.
Kokeilin myös versiota, jossa tavalliseen moduliin ja Tämä työkirja-moduliin laitoin aiemmat koodit.
Sain soluun A1 ainoastaan tyhjän kommenttikentän. Ei siis toiminut.

Luontevaa olisi, jos soluun P4 kirjoittamani/liittämäni teksti siirtyisi reaaliaikaisesti heti enterin painamisen jälkeen A-sarakkeelle aina ensimmäiseen tyhjään soluun ja sen kommenttikenttään.
Yksi ominaisuus kuitenkin toimi aiemmassa versiossa hyvin, eli se huomioi jos joku solu oli välissä tyhjä.
Koodissa on selvästi ainesta, kunhan sitä hieman viilailisi. Tässä kohtaa olen kyllä muiden taitajien varassa, kun en itse hanskaa näitä.

Kiitos "Tämmönen".. sain varsin hyvin tähänastisen version toimimaan.
Muutin A-sarakkeen alkamaan A2 -solusta, joka vastaa paremmin lopullista käyttötilannetta.
Vielä jäi hieman alkuperäistä toivelistaa toteutumatta, tai sitten tee jotain väärin.

Taisin ilmaista toiveeni epämääräisesti..

Ajatuksena oli, että P4 -soluun kirjoitettu tekstitieto siirtyisi välittömästi enterin painamisen jälkeen A-sarakkeen ensimmäiseen vapaaseen tyhjään soluun ja siellä muodostettavaan kommenttikenttään.

Ensimmäinen vapaa tyhjä soluhan voi olla missä kohtaa vaan A-saraketta, kun sarakkeelta tyhjennetään tietoa silloin tällöin, jolloin solut jää tyhjiksi.

Miksiköhän muuten nyt vain ensimmäiseen ylimpään soluun tulee tuo kommenttikenttä ja sekin ainoastaan aloittaessa tyhjää työkirjaa, eikä kaikkiin soluihin, kuten oli tarkoitus?

No nyt toimii lähes mallikkaasti, kiitos.
Vaikkakin tuo toimii teknisesti kuten pitääkin, niin se muutama pieni ominaisuus olisi vielä toivelistalla, eli tieto minkä kirjoitan NYT soluun P4, siirtyisi enterin painamisen tai toisen solun klikkaamisen jälkeen välittömästi seuraavan tyhjän solun kommenttikenttään, eikä vasta seuraavan uuden tiedon lisäämisen jälkeen. Nyt tieto päivittyy ikään kuin viiveellä, eikä reaaliaikaisesti. Pystyykö tuohon vaikuttamaan?

Myöskään A-sarakkeen soluihin ei tarvitse tiedon siirtyä, ainoastaan solun kommenttikenttiin riittää. Tämä oli alkuperäinen toive.

Ideaalitilanne olisi, että P4 -solun tieto siirtyisi ainoastaan A-sarakkeen solujen kommenttikenttiin ja P20:stä tieto siirtyisi A-sarakkeen itse soluun.
Onko tämä hankalaa toteuttaa?
En ensin ajatellut, että tietoa voisi siirtää kahdesta P-sarakkeen solusta A-sarakkeelle.

*Tarpeilija - alkuperäinen kysyjä*
Tähän viimeiseen lisäykseen ei taida olla ratkaisua, eli
Taul1 P4 tieto siirtyisi enterillä A-sarakkeen (2-2000) aina ylimmän vapaan solun kommenttikenttään ja itse soluun siirtyisi tieto P20:stä.
Huomioitavaa, että A-sarakkeen soluja tyhjennetään välillä, eli aina joku solu muuttuu ylimmäiseksi tyhjäksi.

Jostain syystä en saa tätä toimimaan kuten ajattelin.
Tarkoitus oli, että kun kirjoitan(-tai pastetan) soluihin P4 ja P20 tiedot, siirtyisivät ne A-sarakkeelle ensimmäiseen tyhjään soluun ylhältä lukien siten, että P20 tieto siirtyisi itse soluun ja P4 tieto siirtyisi saman solun kommenttikenttään.
Nyt tieto kyllä siirtyy, mutta VASTA ns. seuraavalla syöttökierroksella, eli jos nyt kirjoitan P4 -soluun Tieto1 ja P20 -soluun Tieto2 -siirtyy ne A-sarakkeelle VASTA, kun syötän uudet tiedot P4 ja P20 -soluihin.
Onko siis mahdollista saada tietojen siirtyvän reaaliaikaisesti, eikä vasta seuraavalla syöttökierroksella?

Alla käyttämäni VB koodit. (onko jotain näissä väärin?)


Tavallisessa moduulissa:
Public Edellinen


Tämä työkirja moduulissa:
Private Sub Workbook_Open()
Edellinen = Worksheets("Taul1").Range("P4")
End Sub


Taul1:n moduulissa:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("P4")) Is Nothing Then
Edellinen = Target.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("P4")) Is Nothing Then
For r = 2 To 2000
If Cells(r, 1) = "" Then
On Error Resume Next
Cells(r, 1).Comment.Delete
On Error GoTo Err
Cells(r, 1).AddComment.Text (Edellinen)
Cells(r, 1) = Range("P20")
Exit For
End If
If r = 2000 Then
MsgBox ("Kaikki rivit täynnä!" & Chr(13) & "Edellinen arvo oli:" & Chr(13) & Edellinen)
End If
Next r
End If
Err:
Application.EnableEvents = True
End Sub

Onkohan Excel-gurut kesälaitumella jo.. ;D

Enpäs taaskaan ollut lukenut kunnolla, vaan olin jostain saanut päähäni, että A-sarakkeeseen piti siirtää solun P4 vanha arvo. Siitä tuo viive. Kommenttiin ei voi laittaa mitä tahansa, vaan on varmistettava sen tekstimuotoisuudesta. Solun P20 muuttumista ei ensin pitänytkään tarkkailla. Seuraava Taul1:n moduliin tuleva makro ottaa senkin huomioon ja mitään muita määrittelyitä ei tarvita:

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.EnableEvents = False
   
   If Target.Column = 16 And (Target.Row = 4 Or Target.Row = 20) Then
      For r = 2 To 2000
         If Cells(r, 1) = "" Then
            On Error Resume Next
            Cells(r, 1).Comment.Delete
            On Error GoTo Err
            Cells(r, 1).AddComment.Text (Range("P4").Text)
            Cells(r, 1) = Range("P20")
            Exit For
         End If
         If r = 2000 Then
            MsgBox ("Kaikki rivit täynnä!" & Chr(13) & "Edellinen arvo oli:" & Chr(13) & Edellinen)
         End If
      Next r
   End If

Err:
e = Err.Description
   Application.EnableEvents = True

End Sub

Sain tämän toimimaan.. jotenkin.
Ihan ensimmäisten tietojen syöttö tyhjän taulukkon P4:ään ja P20:een meni mallikkaasti, mutta jo seuraavien syöttöjen kanssa tuli hankaluuksia.. Koodi varmaan toimii jotenkin loogisesti oikein, mutta ei siten kuin ajattelin.
Testasitko itse miten se sinulla toimii?

Nyt tiedot siirtyvät aika villisti väärille soluille ja kommenteille.

Millä ihmeen muokkauksella saisin tämän alla olevan koodin toimimaan siten, että P4 ja P20 soluihin syöttämäni tieto siirtyisi sarakkeen A2-A2000 soluihin, sekä kommentteihin vasta enterin tai napinpainamisen jälkeen?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

If Target.Column = 16 And (Target.Row = 4 Or Target.Row = 20) Then
For r = 2 To 2000
If Cells(r, 1) = "" Then
On Error Resume Next
Cells(r, 1).Comment.Delete
On Error GoTo Err
Cells(r, 1).AddComment.Text (Range("P4").Text)
Cells(r, 1) = Range("P20")
Exit For
End If
If r = 2000 Then
MsgBox ("Kaikki rivit täynnä!" & Chr(13) & "Edellinen arvo oli:" & Chr(13) & Edellinen)
End If
Next r
End If

Err:
e = Err.Description
Application.EnableEvents = True

End Sub