Problem with Macro

  • Thread starter Thread starter danison
  • Start date Start date
D

danison

Hi

I have a query on a macro I am trying to write and cannot figure ou
where it is going wrong. What I am trying to do is to build a mode
whereby I copy and paste a list of words, and then using the macr
automatically create variations on these words in a separate column
placing brackets or punctuation marks around the words in the list. Th
idea is that I can use a different list of words each time, and th
macro converts the entries in the cells to this format to create a
extended list of words.

For example:

Word in list is : dog

The macro copies this word, selects paste special, value, to put a lis
of this word three times in a separate column:

dog
dog
dog

I then have the macro select the second word and put " " around it. I
then applies the same treatment to the third word in the list using [
 
As near as I can tell in the ... 5 minutes I've looked at it, you're VB
code reference absolute words, regardless of what your list look
like.

The modification, as I see it (and again, I haven't spent much time o
it, as my lunch is nearly over) is to reference the previous cell.

Example (based on your original code).


Code
-------------------
Range("D3").Select
testme = Range("C3").Value
If testme <> "" Then
ActiveCell.FormulaR1C1 = """" & testme & """"
End If
-------------------


Replace down the list.

Hope that helps. I'll look at this again in my next break. :)

-Bo
 
Thanks Bob! I will have a look at this later in my break. Must admi
being a newbie to macros, not that familiar with altering code but wil
see what I can make of it!

Bil
 
Ahh, I see. I should have noticed it was a recorded macro. I thought the
code looked a little.....disjointed.

Ok, I've modified the entire recorded macro, without changing the
actual structure. So, it's still disjointed, but it actually works.

To start, Push ALT-F11. This will bring up the VBA Code editor.

You've got your macro under Modules->Module2.

Replace the existing code with the code below. The whole thing. Note,
it's a bit long.

edit: So long, that I can't post it (more than 10000 characters). Do
you have an email address I can send it to?

-Bob
 
Hi Bob

Thanks heaps, that is great! As a newbie to macros, how did you d
this? Did you edit code directly? I gather by your comments that yo
did not record the macro - is is possible to create something like thi
without having to manually adjust every line of code?

Another question for you. I have 50 lines in my 'word list'. If
wanted to extend the macro to pick up all fifty entries if there wer
that many in the list, would I just replicate the following code at th
end of the macro? (I assume I need to work out the absolute cel
references eg. E20, G56, or can I somehow reference these in a relativ
fashion?

ActiveWindow.SmallScroll Down:=-15
Range("E20").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=15
Range("G56").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False



Thanks again for your help

Regards

Bil
 
As I understand it, recording a macro is Excel writing VBA code as yo
do things.

So, for example, when you select a cell when recording a macro, VB
code is written that says Range("A1").Select

The way to do this manually, is to write all the VBA code yourself. Th
benefit, is that you don't get all the extra code that Macro Recordin
generates. The drawback is you have to be exact, and have to know you
code.

2 options.

Option 1:

Just add more lines to the code, and have it search cells 1-50 fo
words.

Option 2: Recode it

Option 2 is the better option, but I'm not 100% sure about the code
Others might be better able to help on that one.

As I see it, you would do a sort of Do...Until loop.

I *think* I might be able to get something together. Let me have a pla
around and I'll get back to you.

-Bob
 
Ok, I surprised myself by working out what the code should look like.

Explaination: The following code will take your list, regardless of how
long it is (could be 1, could be 100, as long as the total list *3
won't go higher than 65535. I don't test for that, but I could.) and
place it, in the same column, with the modifications.

It can be done in another column if you wish (I was unsure as to if you
needed it in the other column, or had just done that out of macro
recording)

This goes as a module in VBA (Alt-F11)


Code:
--------------------


Sub Replacator()
Dim originalvalue
Dim secondvalue
Dim thirdvalue
Dim CurrColumn
Dim CurrRow
Dim NewColumn
Dim NewRow
Dim TestNow
Application.ScreenUpdating = False
TestNow = ActiveCell.Value
While TestNow <> ""
CurrColumn = ActiveCell.Column
CurrRow = ActiveCell.Row
originalvalue = ActiveCell.Value
secondvalue = """" & originalvalue & """"
thirdvalue = "[" & originalvalue & "]"
NewRow = CurrRow + 1
NewColumn = CurrColumn
Cells(NewRow, NewColumn).Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
ActiveCell.Value = secondvalue
NewRow = NewRow + 1
NewColumn = CurrColumn
Cells(NewRow, NewColumn).Select
ActiveCell.Value = thirdvalue
NewRow = NewRow + 1
Cells(NewRow, NewColumn).Select
TestNow = ActiveCell.Value
Wend
Application.ScreenUpdating = True
Beep
End Sub


--------------------


Hope that helps you, let me know how it goes.

-Bob
 
Hi Bob

Gave it a whirl, cut and paste code into Module 1 in VBA, ran it an
for some reason nothing happened. I notice when I go into the VB
modules the code appears in all three. If I delete from any of th
modules, the code disappears altogether. (Please forgive me if this i
a basic lack of knowledge on VBA coding. I am in way over my head o
this programming stuff!)

Love the idea of the macro taking the whole list regardless of lengt
and number of entries. Ideally the macro would take the entries in th
original word list and place the conversion in the 'results list' so
can preserve the original entries. Not absolutely essential howeve
probably the ideal.




Cheers

Bil

Attachment filename: brackets.xls
Download attachment: http://www.excelforum.com/attachment.php?postid=56340
 
Ok, I'll modify the code, and take you step by step through creating
brand new workbook.

I'll be back.

-Bo
 
Thanks Bob, you are a champion! I will try and get back on during
break mid afternoon or so

Cheers

Bil
 
Ok, I think I got it.

Starts where-ever the cursor is. So, you have to click in the firs
cell of the list. Not exactly a big thing, and it means you can do
list from anywhere. Also means you can do half a list, etc.

The next column over, will be the results column. This can be changed
I just made it that way for testing.

So, to start.

File->New->Workbook

Type A1 as List, B1 as Results (obviously, you can make these, or th
whole workbook anyway you want to, this is just to get things started)

Push Alt-F11

Right Click Sheet1, and choose Insert->Module

A blank module will show up.

Paste the following code.


Code
-------------------

Sub Replacator()
'Define Variables

Dim originalvalue
Dim secondvalue
Dim thirdvalue
Dim CurrColumn
Dim CurrRow
Dim ResultsColumn
Dim NewColumn
Dim NewRow
Dim TestNow
Dim SkipNumber
'Set default 'skipping number'
SkipNumber = 4
Application.ScreenUpdating = False

'Set original values
TestNow = ActiveCell.Value
OrigColumn = ActiveCell.Column
OrigRow = ActiveCell.Row
ResultsColumn = OrigColumn + 1

'Begin Loop
While TestNow <> ""

'Set Current Cell
CurrColumn = ActiveCell.Column
CurrRow = ActiveCell.Row

'If starting in the first row, modify
If CurrRow = 1 Then
SkipNumber = 2
End If

'Current Row * 3 (3 mods) - Skip = First Blank Cell
NewRow = (CurrRow * 3) - SkipNumber

'Define Replacements from List
originalvalue = ActiveCell.Value
secondvalue = """" & originalvalue & """"
thirdvalue = "[" & originalvalue & "]"

'Select First Cell
Cells(NewRow, ResultsColumn).Select

'Replace First Value
ActiveCell.Value = originalvalue

'Set Next Cell
NewRow = NewRow + 1
NewColumn = CurrColumn
Cells(NewRow, ResultsColumn).Select

'Replace Second Value
ActiveCell.Value = secondvalue

'Set Final Cell
NewRow = NewRow + 1
NewColumn = CurrColumn
Cells(NewRow, ResultsColumn).Select

'Replace Final Value
ActiveCell.Value = thirdvalue

'Reset to Beginning
NewRow = CurrRow + 1
Cells(NewRow, OrigColumn).Select

'Test if at End of List
TestNow = ActiveCell.Value
Wend
'Reset Excel
Application.ScreenUpdating = True

'Beep completion
Beep
End Su
-------------------


Save your workbook.

Now, I've just modified the code a couple times, because I realised, i
would only work if you started at Cell 1, and then it would only wor
if you started NOT in cell 1. :P Now it checks where you start an
modifies itself accordingly.

If you want to assign a shortcut key to this, Push Alt-F8, highligh
"Replicator" and choose Options.

That should be what you need, let me know how it goes. I'm having
slow day at work, so lots of time to spare.

Hope it helps,

-Bo
 
Thanks, have tried and almost there. Couple of small things:

1. It is not picking up cell A2 for some reason
2. The results list is dumping into column G not column B (no bi
deal, just noticed it)
3. For some reason the replication is stopping at the word "nineteen
and is not continuing the list.

What a challenge!! 8-)

Bil

Attachment filename: replicator.xls
Download attachment: http://www.excelforum.com/attachment.php?postid=56347
 
Perhaps a miscommunication of sorts is occuring then, because I jus
opened the spreadsheet you gave, changed the Macro Shortcut (i
shouldnt make a difference, but I'll just mention it) to Ctrl+Shift+B
clicked Cell A2, Pushed Ctrl-Shift-B and B2-B88 suddenly filled wit
the results. :confused:

I noticed you had columns C,D and E hidden, and they had th
one-nineteen set out, and then column G had the "list" of sorts.

Why was this done? Are you trying to seperate the lists into hidde
columns and then compile them into a larger list?

I'll just try and explain my code a little, so you can see what i
does, and where it differs from the above.

Start in the first cell of the list.

Start of Loop:
Assign a variable (a useful name for a value) to whatever is in th
cell.
Move over to where you are, plus 1 column. (Columns / Rows can b
expressed as numbers and then calculated on, in a way)
Change that cell to the original value.
Move down 1 cell (Row + 1)
Change to the value in quotes "value"
Move down 1 cell (Row + 1)
Change to the value in brackets [value]
Move back to the original cell
Move down 1 cell (Row + 1)
If this NEW cell is empty (end of list) then exit.
Otherwise, begin the loop again.
Beep to let you know it's done.

Whereas, to do it the way I'm seeing on your spreadsheet, you would d
this.

Work with columns instead of rows. Similar to above it would go.

OriginalList -> Original -> "Original" -> [Original]
Next -> Next -> "Next" -> [Next]

And so on, and then, would still need to run the code I have above.

Maybe just outline exactly what you're trying to do, and I'll see i
the current code is what you need, or maybe explain any redundancie
that exist.

-Bo
 
Hi Bob

Fantastic, it works! My mistake, I was not clicking on A2 to start th
replication. I thought from your comments that you could start anywher
and the list would replicate however now realise that is not correct.

Regarding the hidden columns they are redundant. They are from m
earlier attempts to record the macro, when I had the absolut
referencing happening. I have now deleted those columns.

To answer your question about what I am trying to do it is prett
simple - and thanks to you I now have an answer! ; - )

I am wanting to take a list of words, however long, and put into
spreadsheet, press a button and have each of them replicate three time
(1 x original, 1 x quotation marks, 1 x brackets). I then want to b
able to cut and paste that new expanded list into another program. Th
whole idea is to avoid having to manually replicate the words in th
original list and having to add the marks around them.

Brilliant stuff Bob, thanks heaps for all of your help

One day hopefully I can return the favour if I get to macro gur
status!!!

Cheers

Bil
 
Just an FYI, I'm working on a much more ... robust version of the code,
with some help from Excel.Programming. I forgot that you could assign
Cells.Value, without doing ActiveCell.Value. (Assign to any cell, not
just the active one).

As a result, the code is faster, uses less memory, and won't screw up
my Lotus Notes (long and weird story).

The only problem I'm having is finding the last cell. I could do it by
checking Cell.Value <> "", (Not a blank cell), but I think counting the
list to the last cell is a much better way of doing things.

I'll let you know how it goes, and glad I could help.

-Bob
 
Ok, give this code a shot, let me know how it works. :)


Code
-------------------

Sub Listination()

Dim LastRow

Dim CellValue
Dim QuoteValue
Dim SquareValue

Dim OriginalRow
Dim OriginalColumn

Dim CurrRow
Dim CurrColumn
'Dim CurrValue

Dim NewRow
Dim NewColumn

Dim ResultsColumn

Dim SkipNumber
Dim WorkingRow

LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row

OriginalRow = ActiveCell.Row
OriginalColumn = ActiveCell.Column
ResultsColumn = OriginalColumn + 1
CurrRow = ActiveCell.Row
WorkingRow = 1
CurrColumn = 1
CurrValue = OriginalRow

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Start Loop
While CurrRow <= LastRow
'CurrValue = Cells(CurrRow + 1, OriginalColumn).Value
If WorkingRow = 1 Then
NewRow = CurrRow
End If
CellValue = Cells(CurrRow, OriginalColumn).Value
QuoteValue = """" & CellValue & """"
SquareValue = "[" & CellValue & "]"

Cells(NewRow, ResultsColumn).Value = CellValue
Cells(NewRow + 1, ResultsColumn).Value = QuoteValue
Cells(NewRow + 2, ResultsColumn).Value = SquareValue
CurrRow = CurrRow + 1
WorkingRow = WorkingRow + 1
NewRow = NewRow + 3
'EndLoop
Wend
EndOut:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Beep
End Sub

-------------------


Good luck with it. :)

-Bo
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top