Hello,
I am seeking for a help to Concatenate text. Here is the details. I have a value in A1 i.e.Text & Num both and i want to add another cell value by clicking on that cell in the same sheet.
Example:
Column A Column B Column C
Excel Forum .Com
Result:
Column A Column B Column C
Excelforum.com
By clicking the cell it should take that value and added to A1. Something like Concatenate.
Can it be possible.
I it is only assuming so i don;t attached sample file.
This seems to work
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Range("A1").Value = Range("A1").Text + Target.Text End Sub
Thanks for your reply i have forget to tell you.it should cut the text from active cell and past it to the first column. But i was changing the rows. Your script is addting to A1 only.
So, need to complete column. Means if select B3 it should add to B1. If i select D5 the it should add to D1.
My actual column is B.
can someone please
I am attaching the sample file. I have copy a limited data as a sample to grab the idea for a person who is going to help me. The actual file is 110 mb.
I have attached sample file below.
Just check C52, C53 & D71
When i click or select the above mentioned cell it should add to same row column B.
I have found on other website.
You are expert to understand and edit according to my request. Check the code below:-
It is asking 3 input box but what i want here is i will select first the cell which i want to copy and select the second cell where i will keep the original text + the first selection. I hope you understand.
Sub addTwoCellsProc() Dim rngA As String Dim rngB As String Dim rngOutput As String Dim rngTest As Range Do rngA = InputBox("Please enter first cell address", "Cell A") rngA = Range(rngA).Cells(1, 1).Address Set rngTest = Intersect(Range(rngA).Cells(1, 1), ActiveSheet.Cells) Loop Until Not rngTest Is Nothing Do rngB = InputBox("Please enter second cell address", "Cell B") rngB = Range(rngB).Cells(1, 1).Address Set rngTest = Intersect(Range(rngB), ActiveSheet.Cells) Loop Until Not rngTest Is Nothing Do rngOutput = InputBox("Please enter destination cell address", "Output cell") Set rngTest = Intersect(Range(rngOutput), ActiveSheet.Cells) Loop Until Not rngTest Is Nothing Range(rngOutput) = Range(rngA) & Range(rngB) End Sub
I think what you are trying to do is move "Level 1" and "Level 2" data into the description field(Column B). Is this correct?
If this is correct, then the following code should work.
Sub MoveMerge() For MyRow = 4 to 100000 If Range("B"+Cstr(MyRow)).Value = "" Then Exit Sub Range("B"+Cstr(MyRow)).Value = Range("C"+Cstr(MyRow)).Text+ Range("D"+Cstr(MyRow)).Text Range("C"+Cstr(MyRow)).Value = "" Range("D"+Cstr(MyRow)).Value = "" Next MyRow End Sub
Can you check script which i have posted.
Most critical problem is cell and columns are not accurate. I have just given example. My original file is having multiple columns.
I ahve check your script it is replacing the original text instead of adding to original
I think what you are trying to do is move "Level 1" and "Level 2" data into the description field(Column B). Is this correct?
If this is correct, then the following code should work.
Sorry, my bad. I forgot the original value in B column.Sub MoveMerge() For MyRow = 4 to 100000 If Range("B"+Cstr(MyRow)).Value = "" Then Exit Sub Range("B"+Cstr(MyRow)).Value = Range("B"+Cstr(MyRow)).Value + Range("C"+Cstr(MyRow)).Text+ Range("D"+Cstr(MyRow)).Text Range("C"+Cstr(MyRow)).Value = "" Range("D"+Cstr(MyRow)).Value = "" Next MyRow End Sub
I have found this script which meet to my requirement 99%. Only the issue with this script is it is ask the user to enter the cell address, where as i want to just select the cell address it should take automatically.
Sub addTwoCellsProc() Dim rngA As String Dim rngB As String Dim rngOutput As String Dim rngTest As Range Do rngA = InputBox("Please enter first cell address", "Cell A") rngA = Range(rngA).Cells(1, 1).Address Set rngTest = Intersect(Range(rngA).Cells(1, 1), ActiveSheet.Cells) Loop Until Not rngTest Is Nothing Do rngB = InputBox("Please enter second cell address", "Cell B") rngB = Range(rngB).Cells(1, 1).Address Set rngTest = Intersect(Range(rngB), ActiveSheet.Cells) Loop Until Not rngTest Is Nothing Do rngOutput = InputBox("Please enter destination cell address", "Output cell") Set rngTest = Intersect(Range(rngOutput), ActiveSheet.Cells) Loop Until Not rngTest Is Nothing Range(rngOutput) = Range(rngOutput) & " " & Range(rngA) & " " & Range(rngB) End Sub
hec: do you want to add to column B the value from columns C and D when these are not empty? Also, do you want to leave a space between them? Also, should I delete after you add from column C or D once, so that you can't accidentally add it again?
BTW, if your target cells aren't fixed somehow, like the output is column B and you add to it what's in column C and D, then you WILL need to input the cells address. If it is like a typed above, then I know a way to do it.
.?*??)
`?.???.?*??)?.?*?)
(?.?? (?.?Pichingualas <---
??????????????????????????
Wrap your code with CODE TAGS.
Thank those who helped you, Don't forget to add to their REPUTATION!!! (click on the star below their post).
Please mark your threads as [SOLVED] when they are (Thread Tools->Mark thread as Solved).
My problem is i ahve lot of data in Columns C, D, E, F,H, I.
Ofcourse i want to add space inbetween the space.More important it should select multiple range i.e D5:D7
Yes ofcourse it should do something like Cut & Past to the original text.
I hope this will be the last requirement for my request.
Just making sure I understand what you need, sorry if it bothers.Originally Posted by hecgroups
You want to add it to the same row tho right? (D5 should be added to B5, D6 should be added to B6, D7 should be added to B7...)
Also, what's the total amount of columns? Up to and including column I? Is it true that the output cell is in column B (you didn't answer on your last post)?
Out put should be in column But the problem is some cell values i have to take and some i have to ignore. Due to this solution i have post a script in post #11 which meets my requirement 99%.
The only issue with that script is it is asking to enter the single cell value where as i want to select the range to the destination. If you fix it i will be very thankful to you.
I have made a simpler code which might do what you need. Just select your test range and try it out. Do it with F8 if you want to see how it works. Here it goes:
I hope that helps.Option Explicit Sub MoveToColumnB() Dim Rng As Range Dim x As Object Set Rng = Application.Selection For Each x In Rng If x.Value <> "" Then Cells(x.Row, 2) = Cells(x.Row, 2) & " " & x.Value x = "" End If Next x End Sub
BTW do not select column B too.
Hat's off to you boss. You do not know what a valuable help have provided to me from your side. I thanks to you from bottom of my heart. It works find and easier then i was thinking. Just select the cell and it goes to destination.
Topic marked as closed and reputation is added.
Glad to help
I it possible to same logic to extract last 2 letter and past it in column E.
Sure it is. Last 2 letters of which column?
Try with this:
Option Explicit Sub MoveToColumnE() Dim Rng As Range Dim x As Object Set Rng = Application.Selection For Each x In Rng If x.Value <> "" Then Cells(x.Row, 5) = Cells(x.Row, 5) & " " & Right(x.Value, 2) x = "" End If Next x End Sub
Last edited by Pichingualas; 03-27-2012 at 03:19 PM. Reason: Changed sub name a little
Not sure if you wanted to delete the cells copied on this one too. If not, delete the lineI hope that helps.x = ""
There it is i want to extract last 2 letter from my selection.
Also please give me details for script to joint text might be i will use that script in other files also.
The way I'm joining strings in the code above is simply adding to what was already there what I want it to have. That's why I put it likewhich is in reality joining together three sets of strings, as the space counts as a string too. You can add that way any amount of strings you need,str1 = str1 & " " & str2The & serves as a "join this after that"str1 = str1 & str2 & str3 & str4...
What I'm doing is use the first variation:and make it work inside a loop where the str2 goes changing to the current x (which is each cell in your selected range) and str1 is what is in column B of the row where the current x is.str1 = str1 & " " & str2
Last edited by Pichingualas; 03-27-2012 at 03:33 PM.
Did the code I posted above do what you needed? (add the 2 last letters of the selected range to the E column)
I think you misunderstand me.
I said i want to EXTRACT the last 2 words. and one more thing it eh column E is having value then it should ask do you want to over right the resent text.
I hope i make my self clear to you.
Mind you the first time you said letters and now you said words. Which is it you want?
So what you want is to delete the last two letters of each cell in your selection? And have the user confirm if he wants to overwright column E or just delete those 2 letters?
I am sorry Letter.I want to cut those 2 letters from my selection and past it in Column E
Example CB
Ok, do you wish to replace what is in column E or add a space and the two letters?
If the Column E is not empty it should give message do you want to over right the present value Yes/No. If i select yes then it should cut the last 2 letter and past it in column E or if select no nothing will happen.
Try with this:
I hope that helps.Option Explicit Sub MoveToColumnE() Dim Rng As Range Dim x As Object Dim n As Long Dim Answer As Long Set Rng = Application.Selection For Each x In Rng If Cells(x.Row, 5) <> "" Then Answer = MsgBox("Cell E" & x.Row & " is not empty. Do you wish to overwrite it?", vbYesNo, "Move to column E") Else Answer = vbYes End If If Answer = vbYes Then If x.Value <> "" Then n = Len(x.Value) Cells(x.Row, 5) = Right(x.Value, 2) If n > 2 Then x = Left(x.Value, n - 2) Else x = "" End If End If ElseIf Answer = vbNo Then Exit Sub End If Next x End Sub
Slight change that will make it a bit better:
Option Explicit Sub MoveToColumnE() Dim Rng As Range Dim x As Object Dim n As Long Dim Answer As Long Set Rng = Application.Selection For Each x In Rng If Cells(x.Row, 5) <> "" And x.Value <> "" Then Answer = MsgBox("Cell E" & x.Row & " is not empty. Do you wish to overwrite it?", vbYesNo, "Move to column E") Else Answer = vbYes End If If Answer = vbYes Then If x.Value <> "" Then n = Len(x.Value) Cells(x.Row, 5) = Right(x.Value, 2) If n > 2 Then x = Left(x.Value, n - 2) Else x = "" End If End If ElseIf Answer = vbNo Then Exit Sub End If Next x End Sub
Post #33 works fin for me it is perfect.
If i wan tot change the column then what should i do to change the script please tell me.
The change in #34 isn't because #33 didn't work, it is to avoid asking if you want to overwrite it when the current cell you are looking at is empty. It will work just as fine, I advise you to use that one. As for what to change, its simple, change the cell you will be writing in:
That line says "make the value of the cell in column 5 from the current row (the one that our current x is in) equal the last two characters from the current cell (x)". So what you need to change in order to change the column from "E" to something else, is change the column number, in this case 5 for "E".Cells(x.Row, 5) = Right(x.Value, 2)
Last edited by Pichingualas; 03-27-2012 at 04:20 PM.
Thanks to you for valuable help. Topic marked as solved and reputation added to you.
Thanks for the rep. Glad to help
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks