Help converting a recorded macro to a written one

M

mick0005

Active Member
Joined
Feb 21, 2011
Messages
406
Hi everybody -

I recorded a macro, and for the most part it does what I need it to. Only one problem... I now need to be able to move the file to another folder location, or allow users to save as and use the workbook on their own. The problem is that in my recorded macro, I think it is referencing my actual current file name to do some things. If they save it off to another location then the macro won't work. It may also be that I actually recorded the "running" of a macro within one of my macros... it may be referencing that. Either way I am not sure how to fix it.

I am hoping someone can re-write this to make that functionality dynamic.

Below is the code (for all 3 macros I am using in the workbook across 2 or 3 tabs).

I am using excel 2010 on windows 7.

Thank you!

Code: 
Sub SupplierRef()
'
' SupplierRef Macro
'

'
    Application.ScreenUpdating = False
    Columns("C:C").Select
    Selection.Copy
    Columns("L:L").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "00000000"
    Selection.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
    Range("O2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.ScrollRow = 65297
    ActiveWindow.ScrollRow = 64949
    ActiveWindow.ScrollRow = 64428
    ActiveWindow.ScrollRow = 63471
    ActiveWindow.ScrollRow = 61906
    ActiveWindow.ScrollRow = 60167
    ActiveWindow.ScrollRow = 57907
    ActiveWindow.ScrollRow = 56603
    ActiveWindow.ScrollRow = 54168
    ActiveWindow.ScrollRow = 52951
    ActiveWindow.ScrollRow = 50342
    ActiveWindow.ScrollRow = 47212
    ActiveWindow.ScrollRow = 45474
    ActiveWindow.ScrollRow = 39300
    ActiveWindow.ScrollRow = 35562
    ActiveWindow.ScrollRow = 33736
    ActiveWindow.ScrollRow = 30171
    ActiveWindow.ScrollRow = 28345
    ActiveWindow.ScrollRow = 24780
    ActiveWindow.ScrollRow = 23042
    ActiveWindow.ScrollRow = 19651
    ActiveWindow.ScrollRow = 16521
    ActiveWindow.ScrollRow = 15043
    ActiveWindow.ScrollRow = 12173
    ActiveWindow.ScrollRow = 10869
    ActiveWindow.ScrollRow = 8609
    ActiveWindow.ScrollRow = 6609
    ActiveWindow.ScrollRow = 5044
    ActiveWindow.ScrollRow = 4348
    ActiveWindow.ScrollRow = 3131
    ActiveWindow.ScrollRow = 2609
    ActiveWindow.ScrollRow = 1740
    ActiveWindow.ScrollRow = 957
    ActiveWindow.ScrollRow = 697
    ActiveWindow.ScrollRow = 262
    ActiveWindow.ScrollRow = 88
    ActiveWindow.ScrollRow = 1
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=RC[1]&RC[2]"
    Range("A2").Select
    Selection.Copy
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I13").Select
End Sub
Sub PreSupplierRef()
'
' PreSupplierRef Macro
'

'
    Columns("L:L").Select
    Selection.Copy
    Columns("C:C").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.Run "'Pref Mstr Pivot Template - FSL - test.xls'!SupplierRef"
End Sub
Sub Data()
'
' Data Macro
'

'
    Application.ScreenUpdating = False
    Range("I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.ScrollRow = 65399
    ActiveWindow.ScrollRow = 65312
    ActiveWindow.ScrollRow = 65051
    ActiveWindow.ScrollRow = 64703
    ActiveWindow.ScrollRow = 64182
    ActiveWindow.ScrollRow = 63486
    ActiveWindow.ScrollRow = 62268
    ActiveWindow.ScrollRow = 60790
    ActiveWindow.ScrollRow = 58703
    ActiveWindow.ScrollRow = 56442
    ActiveWindow.ScrollRow = 54094
    ActiveWindow.ScrollRow = 51745
    ActiveWindow.ScrollRow = 49223
    ActiveWindow.ScrollRow = 46875
    ActiveWindow.ScrollRow = 45658
    ActiveWindow.ScrollRow = 43049
    ActiveWindow.ScrollRow = 40440
    ActiveWindow.ScrollRow = 37744
    ActiveWindow.ScrollRow = 34961
    ActiveWindow.ScrollRow = 32352
    ActiveWindow.ScrollRow = 29743
    ActiveWindow.ScrollRow = 28526
    ActiveWindow.ScrollRow = 26091
    ActiveWindow.ScrollRow = 23656
    ActiveWindow.ScrollRow = 22525
    ActiveWindow.ScrollRow = 19568
    ActiveWindow.ScrollRow = 18090
    ActiveWindow.ScrollRow = 16872
    ActiveWindow.ScrollRow = 16264
    ActiveWindow.ScrollRow = 15394
    ActiveWindow.ScrollRow = 14524
    ActiveWindow.ScrollRow = 13742
    ActiveWindow.ScrollRow = 13046
    ActiveWindow.ScrollRow = 12437
    ActiveWindow.ScrollRow = 11828
    ActiveWindow.ScrollRow = 11220
    ActiveWindow.ScrollRow = 10959
    ActiveWindow.ScrollRow = 10437
    ActiveWindow.ScrollRow = 9828
    ActiveWindow.ScrollRow = 9306
    ActiveWindow.ScrollRow = 8785
    ActiveWindow.ScrollRow = 8524
    ActiveWindow.ScrollRow = 7828
    ActiveWindow.ScrollRow = 7393
    ActiveWindow.ScrollRow = 6697
    ActiveWindow.ScrollRow = 6523
    ActiveWindow.ScrollRow = 6176
    ActiveWindow.ScrollRow = 5480
    ActiveWindow.ScrollRow = 5219
    ActiveWindow.ScrollRow = 4871
    ActiveWindow.ScrollRow = 4697
    ActiveWindow.ScrollRow = 4262
    ActiveWindow.ScrollRow = 4088
    ActiveWindow.ScrollRow = 3741
    ActiveWindow.ScrollRow = 3393
    ActiveWindow.ScrollRow = 3219
    ActiveWindow.ScrollRow = 2871
    ActiveWindow.ScrollRow = 2697
    ActiveWindow.ScrollRow = 2349
    ActiveWindow.ScrollRow = 2262
    ActiveWindow.ScrollRow = 1827
    ActiveWindow.ScrollRow = 1653
    ActiveWindow.ScrollRow = 1219
    ActiveWindow.ScrollRow = 871
    ActiveWindow.ScrollRow = 610
    ActiveWindow.ScrollRow = 436
    ActiveWindow.ScrollRow = 175
    ActiveWindow.ScrollRow = 1
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
I'd be happy to give this a go for you :)

Can you give me a quick explanation of exactly what each one should do?

Also when I re write I will probably go as far as I can, e.g. You don't need any of the .Select lines, or .ScrollRow lines... would you like comments included so that each part has detailed instructions on what it does?
 
Upvote 0
AD_Taylor said:
I'd be happy to give this a go for you :)

Can you give me a quick explanation of exactly what each one should do?

Also when I re write I will probably go as far as I can, e.g. You don't need any of the .Select lines, or .ScrollRow lines... would you like comments included so that each part has detailed instructions on what it does?
Click to expand...

Thanks! Fantastic.

Comments would be great. I am trying to learn what I can through this website when people help, so comments are very helpful.

The select lines and scroll lines being removed is probably fine, I think those are just there because i moved around the page when i was recording, right?

The macros are basically doing some specific copy, pastes, paste values, concatinates, and i think text to columns in order to make some unique records that I then use in another table for vlookup purposes.

I would be happy to give you the actual spreadsheet to try and use as well if that is easier for you.
 
Upvote 0
AD_Taylor said:
I'd be happy to give this a go for you :)

Can you give me a quick explanation of exactly what each one should do?

Also when I re write I will probably go as far as I can, e.g. You don't need any of the .Select lines, or .ScrollRow lines... would you like comments included so that each part has detailed instructions on what it does?
Click to expand...

Did I give you everything you needed?
 
Upvote 0
Hi Mick,

Think I have everything I needed. Sorry about the slow reply I don't get much time to work on things when its busy!

Try the following. Please make a copy of your file before testing as any changes made by a macro cannot be undone.

Hopefully my comments are useful to you - I've tried to avoid repeating them as well. Let me know if there's anything you don't understand.

Code: 
'This little bit at the top means that when we are working with variables they must all be declared before they can be used.
'Saves a lot of problems that come from declaring a variable with one name and then when using it misspelling the name.
'Because its at the top its applied throughout the module, i.e. to all macros below it.

'If this type of misspelling occurs Excel can flag it up by going to Debug > Compile VBA Project
Option Explicit

Sub SupplierRef()
'
' SupplierRef Macro
'

'Turn off ScreenUpdating to make macro run faster - screen will not show any changes until macro is finished
    Application.ScreenUpdating = False
    
    'Create some range variables to store selections
    Dim copyRng As Range
    Dim destRng As Range
    
    'Working with the ActiveSheet...
    With ActiveSheet
    
        '...Set the 2 variables equal to their corresponding values. Column C will be copied to Column L
        Set copyRng = .Columns("C:C")
        Set destRng = .Columns("L:L")
    
    'Stop working with the ActiveSheet
    End With
    
    'Copies the cells in copyRng (Column C) into the destRng (Column L)
    copyRng.Copy Destination:=destRng
    
    'Set the number format of destRng (Column L)
    destRng.NumberFormat = "00000000"
    
    'Apply Text to Columns to destRng (Column L)
    destRng.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 2), Array(2, 2))
        
    
    'Working with the ActiveSheet again
    With ActiveSheet
        
        'Re use the same variables - set them to their new values
        'copyRng = From O2 down to the final cell in Column O
        Set copyRng = Range(.Range("O2"), .Range("O2").End(xlDown))
        Set destRng = .Range("C2")
        
    'Stop working with the ActiveSheet
    End With
    
    'Copy the copyRng...
    copyRng.Copy
    
    '...Paste Special (Only values) into destRng
    destRng.PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        
    'Working with the ActiveSheet again
    With ActiveSheet
        
        'Re use the same variables - set to their new values
        Set copyRng = .Range("A2")
        Set destRng = Range(copyRng, copyRng.End(xlDown))
    
    'Stop working with the ActiveSheet
    End With
    
    'Add a formula to the cell set in copyRng
    copyRng.FormulaR1C1 = "=RC[1]&RC[2]"
    
    'AutoFill the formula from copyRng down to the last cell in that column (destRng)
    copyRng.AutoFill Destination:=destRng
    
    'Re set copyRng for the final time = Column A
    Set copyRng = ActiveSheet.Columns("A:A")
    
    'Copy that range
    copyRng.Copy
    
    'Paste Special (Only values) back over copyRng (paste its values over itself)
    copyRng.PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        
    'Turn ScreenUpdating back on = True
    Application.ScreenUpdating = True
    
End Sub
Sub PreSupplierRef()
'
' PreSupplierRef Macro
'

'
    Application.ScreenUpdating = False

    Dim copyRng As Range
    Dim destRng As Range
    
    With ActiveSheet
    
        Set copyRng = .Columns("L:L")
        Set destRng = .Columns("C:C")
    
    End With
    
    copyRng.Copy
    destRng.PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        
    'Run the macro SupplierRef - assumes that there is a macro called that and is saved within the same file
    Application.Run "SupplierRef"
    
    Application.ScreenUpdating = True
    
End Sub
Sub Data()
'
' Data Macro
'

'
    Application.ScreenUpdating = False
    
    Dim copyRng As Range
    Dim destRng As Range
    
    With ActiveSheet
    
        Set copyRng = Range(.Range("I2"), .Range("I2").End(xlDown))
        Set destRng = .Range("J2")
    
    End With
    
    copyRng.Copy
    destRng.PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
AD_Taylor said:
Hi Mick,

Think I have everything I needed. Sorry about the slow reply I don't get much time to work on things when its busy!

Try the following. Please make a copy of your file before testing as any changes made by a macro cannot be undone.

Hopefully my comments are useful to you - I've tried to avoid repeating them as well. Let me know if there's anything you don't understand.

Code: 
'This little bit at the top means that when we are working with variables they must all be declared before they can be used.
'Saves a lot of problems that come from declaring a variable with one name and then when using it misspelling the name.
'Because its at the top its applied throughout the module, i.e. to all macros below it.

'If this type of misspelling occurs Excel can flag it up by going to Debug > Compile VBA Project
Option Explicit

Sub SupplierRef()
'
' SupplierRef Macro
'

'Turn off ScreenUpdating to make macro run faster - screen will not show any changes until macro is finished
    Application.ScreenUpdating = False
    
    'Create some range variables to store selections
    Dim copyRng As Range
    Dim destRng As Range
    
    'Working with the ActiveSheet...
    With ActiveSheet
    
        '...Set the 2 variables equal to their corresponding values. Column C will be copied to Column L
        Set copyRng = .Columns("C:C")
        Set destRng = .Columns("L:L")
    
    'Stop working with the ActiveSheet
    End With
    
    'Copies the cells in copyRng (Column C) into the destRng (Column L)
    copyRng.Copy Destination:=destRng
    
    'Set the number format of destRng (Column L)
    destRng.NumberFormat = "00000000"
    
    'Apply Text to Columns to destRng (Column L)
    destRng.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 2), Array(2, 2))
        
    
    'Working with the ActiveSheet again
    With ActiveSheet
        
        'Re use the same variables - set them to their new values
        'copyRng = From O2 down to the final cell in Column O
        Set copyRng = Range(.Range("O2"), .Range("O2").End(xlDown))
        Set destRng = .Range("C2")
        
    'Stop working with the ActiveSheet
    End With
    
    'Copy the copyRng...
    copyRng.Copy
    
    '...Paste Special (Only values) into destRng
    destRng.PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        
    'Working with the ActiveSheet again
    With ActiveSheet
        
        'Re use the same variables - set to their new values
        Set copyRng = .Range("A2")
        Set destRng = Range(copyRng, copyRng.End(xlDown))
    
    'Stop working with the ActiveSheet
    End With
    
    'Add a formula to the cell set in copyRng
    copyRng.FormulaR1C1 = "=RC[1]&RC[2]"
    
    'AutoFill the formula from copyRng down to the last cell in that column (destRng)
    copyRng.AutoFill Destination:=destRng
    
    'Re set copyRng for the final time = Column A
    Set copyRng = ActiveSheet.Columns("A:A")
    
    'Copy that range
    copyRng.Copy
    
    'Paste Special (Only values) back over copyRng (paste its values over itself)
    copyRng.PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        
    'Turn ScreenUpdating back on = True
    Application.ScreenUpdating = True
    
End Sub
Sub PreSupplierRef()
'
' PreSupplierRef Macro
'

'
    Application.ScreenUpdating = False

    Dim copyRng As Range
    Dim destRng As Range
    
    With ActiveSheet
    
        Set copyRng = .Columns("L:L")
        Set destRng = .Columns("C:C")
    
    End With
    
    copyRng.Copy
    destRng.PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        
    'Run the macro SupplierRef - assumes that there is a macro called that and is saved within the same file
    Application.Run "SupplierRef"
    
    Application.ScreenUpdating = True
    
End Sub
Sub Data()
'
' Data Macro
'

'
    Application.ScreenUpdating = False
    
    Dim copyRng As Range
    Dim destRng As Range
    
    With ActiveSheet
    
        Set copyRng = Range(.Range("I2"), .Range("I2").End(xlDown))
        Set destRng = .Range("J2")
    
    End With
    
    copyRng.Copy
    destRng.PasteSpecial _
        Paste:=xlPasteValues, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        
    Application.ScreenUpdating = True
    
End Sub
Click to expand...

Taylor! Buddy! Thanks!

SO it is ALMOST working. I think partially the reason that its not fully working is because I used a silly way to record one of my macros when I set it up. If you can help build in some logic for the existing "SupplierRef" macro, then we could remove the "PreSupplierRef" code altogether and I think it would run perfect!

I have provided a picture for reference.

Basically my objective with the SupplierRef macro is to ultimately get to the number I have in column A. It creates a unique ID that I can then match against in the Data tab. What I need the macro to do though is to NOT override the data in Column C if it has already processed it on a previous run through. Users enter data in columns B through J. What I want the macro to do is to only process the macro against NEWLY entered data... so if the macro has already created a unique ID in Column A, then don't re-process against those and begin applying the macro against the next row without an unique ID yet in column A.

Does that make sense and is it possible?

Thanks so much again!

7-29-20111-09-47PM.jpg
 
Upvote 0
Hi Mick,

Sorry about the incredibly late reply - I've just come back off holiday
Lovely place but no internet connection so I've only just picked this up

Definitely sounds possible, a few things I'd like to make this easier on me...

You said you'd be happy to send over the actual sheet to work with. Is that still possible?
Also how is the unique reference created? i.e. what parts are needed and where, as knowing how to put it together will probably make the code needed much shorter and possibly faster.

Sorry again,
Adam
 
Upvote 0
Sure - I can absolutely send you the file. What would be the best way to do that? Email? If you PM me your email address or some other method of getting the file to you then I can send it right over.

The way that the unique record is created is just by removing the "-" in the number in column C through a text to columns, formatting it so it retains the leading zeroes and pasting that into column L, then it concatinates that new number created in column L (without the dash and retaining the leading zeroes) with the number in column B.
 
Upvote 0
Adam has helped me solve this! We did it with a quick formula using the TRIM function which I have never used. Top notch!

Then we did a simple macro which would copy the new formula down and then paste values over it whenever I ran it.

Fixed everything to work perfectly.

Thanks again!
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
ActiveSheet. Paste error
Replies
1
Views
351
RoryA
RoryA
P
  • Question Question
Help with Vba Code
Replies
3
Views
476
Coyotex3
C
VinceF
  • Solved
VBA to Copy paste value based on value in cell
Replies
4
Views
486
VinceF
VinceF
C
  • Solved
Automation error The Object invoked has disconnected from its clients.
Replies
7
Views
1K
cstuder
C
S
  • Solved
Trying to copy another column from one table to another.
Replies
2
Views
582
Alex Blakenburg
A

Forum statistics

Threads
1,224,609
Messages
6,179,882
Members
452,948
Latest member
Dupuhini

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top