improving speed and efficiency

I need help in trying to improve the speed of my code I have included the code below in the attached test file with some dummy data to show what I’m trying to. as it seemed to long to post all the code.

Any useful suggestions would be greatly appreciated.

Regards
John

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

Thanks for taking the time to read and comply with the rule .

I've edited your title slightly

Removing the selecting will help.

I'm not sure what the "Anon" part is because there doesn't appear to be any such entries. If you can explain what you are attempting then it would help

Edited so far:

Option Explicit
Dim vmgfilename As String
Dim WshShell As Object
Dim SpecialPath As String
'

Sub VirginMoney()
    Dim rg As Range

    Set WshShell = CreateObject("WScript.Shell")    ' Activate shell & get Desktop Path
    SpecialPath = WshShell.SpecialFolders("Desktop")

    'Call donationref '   Add text to ID
    Columns("H").Delete

    '   ask for the filename
    vmgfilename = InputBox("Please enter file name:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                         & "Format Date-Amount eg.  01092009-6798 ", "Enter File Name")

    '    ChDir "Y:\Letters\Donorflex Imports\Virgin Money"
    '    ActiveWorkbook.SaveAs Filename:= _
         '    "Y:\Letters\Donorflex Imports\Virgin Money\VMG-" & vmgfilename & "-Queries", _
         '    FileFormat:=xlNormal, CreateBackup:=False

    '#### Demo purpose only #####
    ChDir SpecialPath
    ActiveWorkbook.SaveAs Filename:= _
                          SpecialPath & "\VMG-" & vmgfilename & "-Queries", _
                          FileFormat:=xlNormal, CreateBackup:=False
    '############################

    '   Add Worksheets
    ActiveSheet.Name = "Donors"
    Sheets.Add
    ActiveSheet.Name = "Anonymous"
    With Sheets("Donors")

        .Columns("A").Insert    ' add new column
        .Range("A1").Value = "Type"    ' Name Column Header

        '   Insert Calculation on each row
        .Range("A2").FormulaR1C1 = "=IF(ISBLANK(RC[12]),""Anon"",""Donor"")"
        Set rg = .Range("A2")   'Starting point of rows to autofill
        Set rg = .Range(rg, Cells(Cells(Rows.Count, 2).End(xlUp).Row, rg.Column))
        rg.Cells(1, 1).AutoFill Destination:=rg, Type:=xlFillDefault
        .Columns("A").Value = .Columns("A").Value
        '   SortBy
        rg.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Thank you RoyUK and PMO

I'm looking at both and will get back to you soon.

PMO, your solution has made me rethink my solution. Having a hiden sheet with the column title with help with future changes and the other payment files I have to manipulate.

At present your solution inserts the columns on the wrong sheet and I only need the new column headings to appear in the "-importdata.csv" file and not in the "-Queries.xls" file.

I have also been imfirmed that Donor vs Anon can be scrapped/changed as only column M "Donor No" will contain numbers for donors and will be blank for anonymous donors. Your solution overwrites these number which are required later, on the import file.


I've amended the code to show the changes:

Set S1 = ActiveSheet
S1.Name = "Donors"
Set R = S1.Range("l2:l" & S1.[a1].CurrentRegion.Rows.Count & "")
var = R

'--- Copy Worksheet---
S1.Copy After:=Sheets(S1.Index)
Set S2 = ActiveSheet
S2.Name = "Anonymous"
'--- DONORS : Delete rows "Anon"  ---
For i& = R.Rows.Count To 1 Step -1
  If var(i&, 1) = "" Then S1.Rows(i& + 1).Delete
Next i&
'--- ANONYMOUS : Delete rows "Donor"  ---
Set R = S2.Range("l2:l" & S2.[a1].CurrentRegion.Rows.Count & "")
var = R
For i& = R.Rows.Count To 1 Step -1
  If var(i&, 1) > 1 Then S2.Rows(i& + 1).Delete
Next i&

Thank you for your help
John