Looping copy and paste macro

[WSmith]

Hello,

I've just learnt VBA a few minutes ago and I need it for a very specific task.
I need to do about 500 times the same thing and so I tried to make a macro to automatize it.
Here is what I want to do :
I have a .txt where there is a text that has the following lines :



some text text1
20 j
100 200
50 j some more text text2

(these are blank lines)

some more text text3
80 500 some more text text4
20 j


What I need to do is to copy this text (manually) and then (everything from here should be automatic) copy in excel the content of the clipboard, while suppressing the blank lines and rotating the lines to make them go in a row (each cell = one line)
Afterwards, I need to go through all the cells I will have created, and for everyone of them that starts with a number, I need to print what is after the number in the current cell (the thing that is after the number is either 'j' or another number, if we don't consider the blanks).
For instance, for the line '100 200' I need to print '200' in this cell instead, and for '50 j' I need to print 'j'.
Then I need to take whatever text is after 'j' or the second number, and display it in the underneath cell.
For instance, for the line '80 500 some more text text4', it will become :
500
some more text text4

This has to be done for all the cells.

In the end, here is the result that I want displayed for the .txt example I gave above (each | represents a column) :

|j|200|j|500|j|
|||some more text text2|some more text text4||



My .txt is not formatted at all which is what makes it so difficult, so I hope you'll be able to help me.

Here is what I tried to do, but obviously there are a lot of errors since I just started learning VBA, but it shows that I at least tried something :


Sub test()
If Application.CutCopyMode = False Then
MsgBox ("nothing to paste")
Exit Sub
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
Do While Selection.Value <> Null ' assuming skipblanks := true worked : while theres a cell to process
Dim s As String
s = Selection.Value
Dim i As Integer
i = 0
s = Trim(s)
Do While IsNumeric(Mid(s, i, 1)) 'get the first number
i = i + 1
Loop
If i <> 0 Then 'if the first number is not found, go to the next cell
Do While (Mid(s, i, 1) = " " Or Mid(s, i, 1) = "\t") 'skip all blanks
i = i + 1
Loop
If Mid(s, i, 1) = "j" Then
Selection.Value = "j" 'print j in the current cell
ElseIf IsNumeric(Mid(s, i, 1)) Then
Dim j As Integer
j = i
Do While IsNumeric(Mid(s, j, 1)) 'get the second number
j = j + 1
Loop
Selection.Value = Mid(s, i, j - i) 'prints the number in the current cell
End If
Selection.Offset(0, 1).Value = Mid(s, j, Len(s) - j) 'print the remains of the cell below.
Selection.Offset(1, 0).Select 'select the next cell to process
End If
Loop
End Sub



Thanks.

[Simon Lloyd]

Firstly you may have tried that code but it isn't yours, if it is, and you state your just learning VBA can you teach me? :)

From what you have supplied it isn't clear what you are attempting to do, can you supply a workbook with the before and after look so we can see your structure and what you want to acheive?

[WSmith]

I'm sorry I have some trouble to understand what you mean... are you claiming this code isn't mine ? It is, I just wrote it.

It isn't easy for me to supply exactly the structure of the text to parse, because I didn't write it, I'm just trying to insert it into a sheet.
But basically, all lines have one of the following forms (the operation to be made is in parenthesis :
- text lines (to ignore)
- blank lines (to ignore)
- a number + some blanks or none + a number + some blanks or none + some text (retrieve the second number, and if 'some text' isn't null, put it on the cell underneath)
- a number + some blanks or none + j + some blanks or none + some text(retrieve 'j', and if 'some text' isn't null, put it on the cell underneath)

So here is an example :
This is what is on the .txt :
some text text1
20 j
100 200
50 j some more text text2

(these are blank lines)

some more text text3
80 500 some more text text4
20 j

And this is what I want to obtain after the macro has been executed (assuming the text above is in the clipboard).
A1 = j
A2 = 200
A3 = j
A4 = 500
A5 = j
B3 = some more text text2
B4 = some more text text4

[WSmith]

I don't have a workbook at hand, is this enough for you to understand what I want ?
Can you help me to correct the function I've done ?

Thanks.

[rbrhodes]

Hi WS,

Nice first attempt. Rather than 'fix' yours I took a different approach. It's commented so I'm hoping you can deduce what is being done:

- Calculate selected rows and columns

- Get each selected cell and if not blank, use 'Split' function to break it into items in (zero based) array. If blank get next cell value.

- Check first item is number. Yes = check there is a second item and check if it is a number. if no second item or is not number do next cell

- If numbers write second one then check if any remaining items. Write those if so, go next if not.

I also use 'Option Explicit' to require variable declaration, ScreenUpdating for speed and 'GoTo 'Label' for skip ahead and also 'Goto label' for an exit point in code (rather than 'Exit Sub').

FYI, 'Option Base 1' doesn't affect the 'Split' function, BTW but it was a JIC, etc <acronymonious grin>.

[WSmith]

Err how can I add something to the clipboard ?
If I do a ctrl+c from the notepad, it doesn't seem to work...
It doesn't work either if I do a ctrl+c from excel itself...

[mdmackillop]

Here is his Code. Press Alt + F11 to see it in Module 1

Option Base 1
Option Explicit
Sub test()

Dim StrArr
Dim getRow As Long
Dim destCol As Long
Dim destRow As Long
Dim myStr As String
Dim LastRow As Long
Dim ArrCountr As Long
'Speed
Application.ScreenUpdating = False
'Check if clipboard
If Application.CutCopyMode = False Then
MsgBox ("Nothing to paste")
GoTo endo
End If

'Check if multi Column: One column only!
If Selection.Columns.Count > 1 Then
MsgBox ("Single column please...")
GoTo endo
End If

'Get last row of selected data
LastRow = Selection(Selection.Rows.Count).Row

'Dest column (is currently selected Col + 1)
destCol = Selection.Column + 1
'Init dest row (so each item ends up consecutive, eg skip blank rows)
destRow = Selection(1).Row
'Do all rows in selection
For getRow = Selection(1).Row To LastRow
'Get and trim value
myStr = Trim(Cells(getRow, Selection(1).Column))
'Anything there (Skip blanks, could check if blank first...)
If myStr = "" Then GoTo nextcel
'Split into (zero based) array
StrArr = Split(myStr, " ")
'Check 1st array item
If IsNumeric(StrArr(0)) Then 'got the first number
'Check array has more than 1 item
If UBound(StrArr) < 1 Then
'Nope. move on to next cell
GoTo nextcel
End If
'First was number, check second item (is j or number?)
If StrArr(1) = "j" Or IsNumeric(StrArr(1)) Then
'Print "j" or 2nd number
Cells(destRow, destCol) = StrArr(1)
'Check array has more than 2 items
If UBound(StrArr) < 2 Then
'Nope. Incr dest row
destRow = destRow + 1
'and go to next cell
GoTo nextcel
End If
'Clear ssting for reassemble
myStr = ""
'Add all pcs except last one (or add all then trim trailing space)
For ArrCountr = 2 To UBound(StrArr) - 1
myStr = myStr + StrArr(ArrCountr) & " "
Next ArrCountr
'Add last pc
myStr = myStr & StrArr(ArrCountr)
'Put reassemled string in cell next to last item
Cells(destRow, destCol + 1) = myStr
'Increment
destRow = destRow + 1
End If
End If
'Come here if cell blank, etc
nextcel:

Next getRow

'Exit point
endo:
'Reset
Application.ScreenUpdating = True
End Sub

[WSmith]

Yes I just figured it out on my own too, sorry for the dumb question. I edited it and I asked another question, which is (see above) how to make
Application.CutCopyMode = True

[Aussiebear]

Please don't go back and edit your posts to change the question relating to the original issue. Simply start a new post in the thread.

[WSmith]

Well it lasted 30 seconds or so, didn't think anyone had had enough time to read it. Apparently I was mistaken, sorry about that.

Anyway the macro you gave works, but I would have liked to be able to use the copy/paste function :
instead of selecting the cells that I want to modify, I want to be able to copy them from a .txt and run the macro, which would automatically paste the text in the clipboard while doing the required operations. This feature doesn't work at the moment, how do I make it work ?
I also want the text to be displayed horizontally and not vertically, hence the transpose:=true that I tried to implement.
The text should be pasted in the active cell and the consecutive cells.

I Also have a question regarding the code : what happens to split(," ") if there are more than one consecutive blanks (as in "40 j")? Would strArr(1) still work, or return a " " string ?

Thanks.

[rbrhodes]

Ah,

More info.

Which usually makes the original question 1 of 2 or more: Clearer, redundant, what?, etc.

You want to copy from a *.txt file to an Excel File via the 'Clipboard.


<?>


dr

[WSmith]

Yes I do, but this was the second part of my plan.
At first, all I want is to do the copy (ctrl+c) manually from the .txt file, and have Excel do the rest from there (paste and transpose the text and do the operations that you correctly implemented). But if you find that it's just as easy to implement the second step right away, here it is :
Afterwards, when this works correctly and when I'm satisfied with the result, the next step will be to load automatically many text files and have excel do the above mentionned operations, with the following constraints :
I need to load the text from a file, for every file in C:\ that starts with "load" and ends with ".txt".
The text needs to be pasted starting from the current active cell.
The second number or 'j' must be written in the row i. The optional text that follows must be written on the same column but on the row i+1 (the cell below) : it's pretty much what you made, except that it's transposed (rows and columns are inverted).
The second file needs to be pasted at rows j+1 or j+2 if there is any text that has been written on row j+1.
The contents of the third file needs to be pasted on the next available row (j+2 or j+3 or j+4 depending on what has been done for the first and second file).
The starting column shall always be the one that was selected before the macro was launched, and the same goes for the starting row.
etc.

[WSmith]

Can someone help me please ?

[rbrhodes]

Hi WS,

Well here's a working example of what you described. It falls a little outside of 'free advice' tho I must say. More into the realm of a project.

However because you did ask for help and because you took the extra time to explain the problem thoroughly I built it for you. Let me know if it works and if you have any questions post here or email me.

[WSmith]

thanks a lot !!
It works perfecly, just as I wanted.
It wasn't easy to express myself but you understood what I wanted.
There are some features that could be better though :
- some special characters (accents, ...) aren't displayed correctly. Is there an option with OpenText that could change that ?
- I sometimes have to insert 3/4 (=0.75) as a text in a cell but excel automatically translates this as a date. Can I avoid it ?
- I tried to make a shorcut to the macro. If I launch it with 'execute macro', it runs correcly. But if I launch it with the shortcut, a new sheet is opened. How can I fix this ?
- It seems that when there's only one blank in a line, then the line isn't retrieved.
- There's a special case that I didn't consider and didn't explain but that I would like implemented : sometimes, the 'j' is followed by another text, without a space. I would like this text to be inserted in the cell below as it would if there were a space.
Something like this, I guess :
'First was number, check second item (is j or number?)
If LCase(StrArr2(1)) = "j" Or IsNumeric(StrArr2(1)) Then
'...
ElseIf LCase(Left(StrArr2(1),1)) = "j" Then
Str=Right(StrArr2(1),UBound(StrArr2(1))-1)
'Add all pcs except last one (or add all then trim trailing space)
For ArrCountr = 2 To UBound(StrArr2) - 1
myStr = myStr + StrArr2(ArrCountr) & " "
Next ArrCountr
'Add last pc
myStr = myStr & StrArr2(ArrCountr) - Also, if the text starts with a '+', it would be great to just ignore the '+'.Probably
Probably something like :
For ArrCountr = 2 To UBound(StrArr2) - 1
If StrArr2(ArrCountr) <> "+" Then
myStr = myStr + StrArr2(ArrCountr) & " "
End If
Next ArrCountr The problem is that this doesn't handle the "+" without a space after or without a space before, and that it checks for all words but only the third one should be tested.
Thanks.

[rbrhodes]

dbl post

[rbrhodes]

Ignore this one then?


hi rbrhodes,
thanks a lot for your help.
I can't manage to make it work though.
Here's what I did :
I created a text file C:\load0.txt and I put the following text inside :

I then pressed 'button 1'.
The procedure failed at line 54-57 : "Workbooks.OpenText", with the following error :
"Execution error '1004'.
'load0.txt' can't be found. Check the spell and name and path, etc."
sname = "load0.txt"
pth = "C:\"
fil = "load*.txt"

I'm the admin of my computer so there shouldn't be any problems to open the file.

Any idea what's wrong ?

Thanks.




And on to this:

- some special characters (accents, ...) aren't displayed correctly. Is there an option with OpenText that could change that ?

>> You could try changing the origin in OpenText from xlMSDOS to xlWindows or if that doesn't work try code pages

- I sometimes have to insert 3/4 (=0.75) as a text in a cell but excel automatically translates this as a date. Can I avoid it ?

>> Format the cell as fraction instead of date

- I tried to make a shorcut to the macro. If I launch it with 'execute macro', it runs correcly. But if I launch it with the shortcut, a new sheet is opened. How can I fix this ?

>> 'Shortcut?' I think an example might explain this better. I made a 'shortcut' and it worked fine

- It seems that when there's only one blank in a line, then the line isn't retrieved.

>> Don't get this either. Trim removes leading and trailing spaces, 'Split' breaks the line into 'items and the Redim Preserve function kills any multiple blanks left by 'Split'. So if the cell is blank = done. If the cell only has one item = done, 2 items the first one is tested for numeric else =done. First is numeric, iss 2nd numeric or 'j' = done etc...

- There's a special case that I didn't consider and didn't explain but that I would like implemented : sometimes, the 'j' is followed by another text, without a space. I would like this text to be inserted in the cell below as it would if there were a space.

>> So first item is number and space then judy is my sister =

J
is my sister


>>Is that right?


Also, if the text starts with a '+', it would be great to just ignore the '+'.

>> Special text only right? (text that is to be copied to row i + 1)



<snip>
'Get first pc
If Left(StrArr2(2), 1) = "+" Then
myStr = Right(StrArr2(2), Len(StrArr2(2)) - 1)
Else
myStr = StrArr2(2)
End If
'Add all pcs except last one (or add all then trim trailing space)
'Get next pcs
For ArrCountr = 3 To UBound(StrArr2) - 1
myStr = myStr + StrArr2(ArrCountr) & " "
Next ArrCountr
'Add last pc


<snip>




The problem is that this doesn't handle the "+" without a space after or without a space before, and that it checks for all words but only the third one should be tested.

>> the above will check the 3rd word for a leading "+" and remove it

example "+some" becomes "some".

If there's other examples then they will need explaining as well.

I could continue to look at this in my spare time but if you want the work done fast hopefully someone else will pick this up. I answer questions for free but projects are on a 'hire' basis. Click my sig for my website and attitude (conditions).

you could post or email some example text files that have all of the extremes you want to catch (or at least all the ones youc an think of)

Ciao for now

dr