cut and paste

[jokester]

Hi all,
I'm new to Macros and don't know much about VBA. But I want to format a large amount of data. So, the query is this, I have cells with contents in Japanese that I want to cut and paste into another cell that has its english romaji. So for example, ベツ, this is in one cell. I want to cut it and paste in another cell with a comma after. I'll paste a screen shot so you can see which cells and how i want to do that. Please help me out. Also there is like 600 of these so a loop would be great. I'm sending a small snippet of it where I have done the formatting and where the formatting has to be done so please have a look! And also I did try to do a macro recording but what it did was put ??? where the japanese was and copy the same text from recording one into the new cell where I ran the macros. Basically, did not understand that the text has to be what is in the destination cell already and copy the current cell contents into the destination with a comma after to separate the two. Also, include a code to delete the empty row after the cut and paste and loop

Jlpt kanji.xlsm
	A	B	C	D	E
121	12	場	ジョウ, jou	ば, ba	location, place
122	13	員	イン, in		employee, member, number, the one in charge
123	14	立	リツ, ritsu	た(つ), ta(tsu)	stand up, rise
124	15	開	カイ, kai	ひら(く)、 あ(ける), hira(ku), a(keru)	open, unfold, unseal
125	16	手	シュ, shu	て, te	hand
126	17	力	リョク、 リキ, ryoku, riki	ちから, chikara	power, strength, strong, strain, bear up, exert
127	18	問	mon	to(u)	question, ask, problem
128			モン	と(う)
129	19	代	dai	ka(wari)	substitute, change, convert, replace, period
130			ダイ	か(わり)
131	20	明	mei, myou	aka(rui)	bright, light
132			メイ、 ミョウ	あか(るい)
133	21	動	dou	ugo(ku)	move, motion, change
134			ドウ	うご(く)
135	22	京	kyou, kei, kin	miyako	capital
136			キョウ、 ケイ、 キン	みやこ
137	23	目	moku, boku	me	eye, class, look, insight, experience
Sheet1

 

[Micron]

I think you'd help everyone to help you if you showed the before and after, not just the after. After reading your post several times, I can't imagine what it must have looked like before. Maybe the forum alters your typing, because my browser cannot find ベツ more than once (only in your explanation, not in the data), so there's no way to see where it was before.

 

[jokester]

I think you'd help everyone to help you if you showed the before and after, not just the after. After reading your post several times, I can't imagine what it must have looked like before. Maybe the forum alters your typing, because my browser cannot find ベツ more than once (only in your explanation, not in the data), so there's no way to see where it was before.

HI! thanks for replying first of all. And that was just an example, take, "モン" for example in entry 128. Its translation is written in 127 as "mon". That is the before. The entries after 127 are the examples and before that is what I manually did and what I want to accomplish. "カイ" in entry 124 is what was written in the cell below, which I cut and pasted with a comma after, to separate its meaning, "Kai" and deleted the empty row. I did that for both the C and D columns

 

[kevin9999]

I think I understand what you're looking for. Try the following on a copy of your sheet. With only 600 of these entries it should be fast enough, but if the entries get into the thousands, we may have to revisit.

Option Explicit
Sub jokester()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")  '<~~ change to actual sheet name
    Dim LRow As Long, i As Long
    LRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
    For i = LRow To 3 Step -1
        If Cells(i, 3).Offset(, -1) = "" And Cells(i, 3).Offset(-1) <> "" Then
            Cells(i, 3).Offset(-1) = Cells(i, 3) & ", " & Cells(i, 3).Offset(-1)
            Rows(i).EntireRow.Delete
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[kevin9999]

Ignore post #4, use this one instead.

Option Explicit
Sub jokester2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")  '<~~ change to actual sheet name
    Dim LRow As Long, i As Long
    LRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
    For i = LRow To 3 Step -1
        If Cells(i, 3).Offset(, -1) = "" And Cells(i, 3).Offset(-1) <> "" Then
            Cells(i, 3).Offset(-1) = Cells(i, 3) & ", " & Cells(i, 3).Offset(-1)
            Cells(i, 3).Offset(-1, 1) = Cells(i, 3).Offset(, 1) & ", " & Cells(i, 3).Offset(-1, 1)
            Rows(i).EntireRow.Delete
        End If
    Next i
    Application.ScreenUpdating = True
End Sub