Free Microsoft Excel 2013
Quick Reference
Free Microsoft 2013 Quick Reference Guide

Free Microsoft Excel 2013 Quick Reference

Printing using Macro?

Hi, i need a VBA code that can select the data and then print, i find highlighting range of data which runs into 100's of rows is very time consuming, i would like the code to only print the data and ignore #N/A, since there is a formula in the stock column.

Below is only a sample of what the data looks like, real data is around 200 rows. The code should take into account title which is on row 2 and data starts on A4:E???

StockDateHoldingSIDEAGEBHP12/07/20082343LDR21RIO13/07/200852523SCR34BT14/07/2008324234LCR23VODA15/07/20084656SDR12BARCLAYS16/07/2008567563SCR43#N/A#N/A#N/A#N/A#N/A#N/A#N/A#N/A#N/A#N/A


Post your answer or comment

comments powered by Disqus
Hi. I need some help regarding printing letters/correspondence using macros. I have a workbook with two sheets in it. Sheet1 contains a table of names, home addresses, and cities. It also has a corresponding number for each range/row. Sheet2 contains the format of my letter, which i made a link to sheet1. On cell A1 of sheet2 i encode or type the number that corresponds to the each range/row that has a name, address, city to be print. Can anybody please help me print them all without encoding the corresponding number one at a time? I tried recording a macro by a batch of 10. But if i have more than 10 letters to be sent, i have to encode "11" and "12" and so forth... hope someone can help me thanks.

I have a spreadsheet of 62rows 7 columns.
like to use macro to print from A1 to G2 on one page.
Then A3 to G4 on next page and so on ending in A61 to G62.
Please advise howto create macro. Will attach file if needed.
Thanks.

Suppose there are 3 worksheets in a workbook and I want to print all the 3 worksheets using macro. I was able to write the macro, but it is displayng the worksheet on the screen while proceeding for printing. What I want is the the sheets being printed should not be displayed on the screen while printing.

Thanks in advance

Does anybody know a way to use a macro to assign an alternate printer other
than the default printer on a network?
I have a macro in place to print a file, but have to change the default
setting every time before I start using the file. I am tryng to figure out a
program to use macros to accomplish it for me.
--
John

Hello,

I created a macro to process certain data and print a specified range of a worksheet. For the first to third week of use, I can say that it is productive. But later on the processing becomes too slow, opening the file becomes too slow eventhough the file doesn’t accumulate any data . Any idea about this?

Thanks in advance!

Hi All,

I need some assisstant with a problem it have at work.
I've attached the worksheet here for easy understanding.

I have this worksheet called PO and this form is actually standard form which not allow us to add in column nor row. The big problem on this form is only allow us to enter 2 grades in 1 form.

My question is:-
1. Use macro to "Add Grade". When I click on "Add Grade", Row 20 : Row 26 will be copy & paste after row 26.
2. When print out. The form must be exactly look like the PDF file I attached. Which is 2 grade in 1 sheet.

Said if I have 3 grade now. G1, G2 and G3. I click "Add Grade" my current PO will allow me to enter 4 grade. After key-in G1, G2 and G3. The print out must be G1 & G2 in one paper & G3 in the other paper.

Hope someone can help me to solve this problem.

Thanks in advance.

Warm Regards.

Hi,
I assgined a macro to a "text box" using "record new macro". This macro
prints a certain range of cells on a laser printer.
When I replaced the printer with a colored one: HP deskjet and run the
macro it didn't print.
following is the code of the macro:
Sub TextBox1_Click()
Range("A14:F26").Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.PrintOut Copies:=1, Preview:=True, Collate:=True
End Sub

Can anyone help
Khalil

Hello im a vb noob.

any one can help me solve my problems.

i have a code here from Ron de Bruin.
that merge text file.

my problem is how can i filter my data, range:all in column A that starts with value:A, AB or ABC and paste it the entire row to the other worksheet using macro.

thanks.

Declare Function
OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103


Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long
'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


Sub Merge_CSV_Files()
Dim BatFileName As String
Dim TXTFileName As String
Dim XLSFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim DefPath As String
Dim Wb As Workbook
Dim oApp As Object
Dim oFolder
Dim foldername

'Create two temporary file names
BatFileName = Environ("Temp") & _
"CollectCSVData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat"
TXTFileName = Environ("Temp") & _
"AllCSV" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt"

'Folder where you want to save the Excel file
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "" Then
DefPath = DefPath & ""
End If

'Set the extension and file format
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
'If you want to save as xls(97-2003 format) in 2007 use
'FileExtStr = ".xls": FileFormatNum = 56
End If

'Name of the Excel file with a date/time stamp
XLSFileName = DefPath & "MasterCSV " & _
Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr

'Browse to the folder with CSV files
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.BrowseForFolder(0, "Select folder with CSV files", 512)
If Not oFolder Is Nothing Then
foldername = oFolder.Self.Path
If Right(foldername, 1) <> "" Then
foldername = foldername & ""
End If

'Create the bat file
Open BatFileName For Output As #1
Print #1, "Copy " & Chr(34) & foldername & "*.csv" _
& Chr(34) & " " & TXTFileName
Close #1

'Run the Bat file to collect all data from the CSV files into a TXT file
ShellAndWait BatFileName, 0
If Dir(TXTFileName) = "" Then
MsgBox "There are no csv files in this folder"
Kill BatFileName
Exit Sub
End If

'Open the TXT file in Excel
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False

'Save text file as a Excel file
Set Wb = ActiveWorkbook
Application.DisplayAlerts = False
Wb.SaveAs Filename:=XLSFileName, FileFormat:=FileFormatNum
Application.DisplayAlerts = True

Wb.Close savechanges:=False
MsgBox "You find the Excel file here: " & vbNewLine & XLSFileName

'Delete the bat and text file you temporary used
Kill BatFileName
Kill TXTFileName

Application.ScreenUpdating = True
End If
End Sub


Hi All,

I'm actually an idiot about VBA . Could you help me on my problem?

I have a document which user are allow key-in 2 products only and does not allow me to insert rows. Therefore, whenever I would like to add Product, I have to copy the entire page and paste in a new sheet in order for me to enter the 3rd and 4th product.

Is it possible to use macro to create "INSERT ROW" (repeat row20 to row26) to allow user key in the 3rd product and when print out it must be 2 grades in 1 sheet. Which mean its repeat the header row 1 to row 17 and repeat the footer row 27 to row 43. Therefore, if I have 3 products, it will print out in 2 pages which is 1st page 2 product, 2nd page 1 product with 1 empty product.

Thanks for any help.

Regards.

Hi guys,

I have a workbook with several worksheets - 1 of which is a control sheet that has options for the user to print.

I have 4 option boxes -
1) A4
2) A3
3) Landscape
4) Portrait
and 1 check box
1) Text Wrap
and 1 command button to Print using the selected options

I need a macro that looks at the whether these option boxes are ticked or un-ticked and makes the appropriate changes to all worksheets besides the worksheet that the option buttons/ boxes are contained on - sheet name "Welcome"

Regards

I have a couple spreadsheets which update using a RTD link. I then use Macros to sort it and publish a html file every 30 seconds.

I found the html macro thanks to : http://www.meadinkent.co.uk/xlhtmltable.htm

The problem is that whenever I run two sheets together, the macro that creates the html file at times gets the data off the wrong worksheet. Sometimes I only see one sheet's data being used, sometimes the other.

Both html files when published have some feature from one macro and some from the other macro. Like macro one sheet says use 1528 rows and the title for page is Relative Strength Over 750K. Other macro says use 979 rows and title for page is Relative Strength Under 750K. I would have both the sheets as like 1528 rows for with title Relative Strength Under 750K.

If I run one sheet at a time, everything works fine.

Here are the Macro codes for Sheet #1:

ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime dTime, "Macro1", , False
End Sub

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:30"), "Macro1"
End Sub Module 1

Public dTime As Date

Sub Macro1()
dTime = Now + TimeValue("00:00:30")
Application.OnTime dTime, "Macro1"
Columns("P:AH").Select
Selection.Sort Key1:=Range("AG1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
Run "MakeHTM_Over"
End Sub Module 2

Option Base 1 ' sets first array element to 1, not 0
Sub MakeHTM_Over()
' Defining a list of variables used in this program
Dim PageName As String, FirstRow As Integer, LastRow As Integer
Dim FirstCol As Integer, LastCol As Integer, MyBold As Byte
Dim TempStr As String, MyRow As Integer, MyCol As Integer
Dim MyFormats As Variant, Vtype As Integer, MyPageTitle As String

' MyFormats is an array which can contain formats for numbers
' and dates. Add one element for each table column.
MyFormats = Array("", "#,", "#,##0.00;(#,##0.00)", "0.00", "0.00", "0.00", "#,", "0.00", "0.000", "0.00", "0.00", "0.00", "#,##0.00;(#,##0.00)", "0.00", "", "", "", "", "", "", "", "0.00", "", "")

PageName = "C:WebPagesrs_over_750k.html" 'location and name of saved file
MyPageTitle = Range("A2").Value

FirstRow = 1 ' the range of the worksheet to be
LastRow = 1528 ' converted into an HTML table
FirstCol = 16
LastCol = 39

If UBound(MyFormats) < (LastCol - FirstCol + 1) Then
MsgBox "The 'MyFormats' array has insufficient elements", vbOKOnly + vbCritical, "MakeHTM macro"
Exit Sub
End If

Open PageName For Output As #1
Print #1, "<html>"
Print #1, "<head>"
Print #1, "<title>Relative Strength Over 750K</title>"
Print #1, "<style type='text/css'>"
Print #1, "body {font-family: Verdana, sans-serif; font-size: 10pt; margin-left: 10; margin-right: 10; color: #FFFFFF; background-color: #383838; text-align: center;}"
Print #1, "td {padding: 1pt 3pt 2pt 3pt; border-style: solid; border-width: 1.5; border-color: #383838; font-size: 10pt; text-align: left;}"
Print #1, "table {border-collapse: collapse; border-width: 1.5 ; border-style: solid; border-color: #383838;}"
Print #1, "</style>"
' The next line refers to a cascading style sheet as an alternative to the <style> instructions
' Print #1, "<link rel='stylesheet' type='text/css' href='mikbasic.css'>"

Print #1, "</head>"
Print #1, "<body>"
Print #1, "<h1>" & MyPageTitle & "</h1>"
Print #1, "<table>"
For MyRow = FirstRow To LastRow
Print #1, "<tr>"

For MyCol = FirstCol To LastCol
If Cells(MyRow, MyCol).Font.Bold = True Then
MyBold = 1
Else
MyBold = 0
End If

Vtype = 0 ' check whether the cell is numeric
If IsNumeric(Cells(MyRow, MyCol).Value) Then Vtype = 1
If IsDate(Cells(MyRow, MyCol).Value) Then Vtype = 2

' if numeric and a format code has been created, apply it
If Vtype > 0 And MyFormats(MyCol - FirstCol + 1) <> "" Then
TempStr = Format(Cells(MyRow, MyCol).Value, MyFormats(MyCol - FirstCol + 1))
Else
TempStr = Cells(MyRow, MyCol).Value
End If

If MyBold = 1 Then
TempStr = "<b>" & TempStr & "</b>"
End If

If Vtype = 1 Then ' align numbers (not dates) to the right
TempStr = "<td align='right'>" & TempStr & "</td>"
Else
TempStr = "<td>" & TempStr & "</td>"
End If

' if a table cell is blank, add a space
If TempStr = " <td></td>" Or TempStr = "<td align='right'></td>" Then
TempStr = " <td>&nbsp;</td>"
End If

Print #1, TempStr
Next MyCol
Print #1, "</tr>"
Next MyRow

Print #1, "</table>"
Print #1, "<p><small>Last Updated: " & Format(Date, "dd mmm") & " | " & Format(Time, "ttttt") & "</small></p>"
Print #1, "</body>"
Print #1, "</html>"
Close #1
End Sub I have attached the codes for sheet #2 as a txt file.

Would appreciate any help what so ever. Thanks!

Hi gurus,
Presently I need to develop a macro that can apply page break in excel 2002 on the basis of the values of a particular column in the excel

example
CURRENT EXCEL

Print Output in 1st page

Col1 Col2

1 a
0 b
0 c
1 d
0 e
1 f
0 g
0 h

I need to apply page break before the last cell value of col1 when the cell value=1using the macro mentioned below.

EXCEL REQUIRED AFTER APPLYING CONDITIONAL PAGE BREAK USING MACRO
Print Output in 1st page

Col1 Col2

1 a
0 b
0 c
1 d
0 e

Print Output in 2nd page
Col1 Col2

1 f
0 g
0 h

MACRO DEVELOPED SO FAR
----------------------------------------------START------------------------------------------------
sList = sList & sFile & vbTab & sNewFileName & vbCrLf
objFSO.CopyFile sFile, sNewFileName

'Revenue excel report formatting start 
						spos=InStrRev(sNewFileName,"Revenue")
						
						csFile.WriteLine "Inside Revenue excel report formatting Spos"+" "+ Cstr(spos)
								if(spos>0) then
										set app = createobject("Excel.Application")
										set objWorkbook = app.Workbooks.Open(sNewFileName)
                                                                objWorkbook.Sheets("Revenue-1").Select
                                                                objWorkbook.Sheets("Revenue-1").Name =
"Revenue"
											objWorkbook.worksheets(objWorkbook.ActiveSheet.Name).activate  
										set excelsheet =  objWorkbook.worksheets(objWorkbook.ActiveSheet.Name)
										csFile.WriteLine "set excelsheet width"
											 excelsheet.activate 
											 excelsheet.Columns("A:A").ColumnWidth = 0.08
											 excelsheet.Columns("B:C").ColumnWidth = 0
											With excelsheet.PageSetup
														.PrintTitleRows = "$3:$5"
														.CenterHeader = ""
														.RightHeader = ""
														.LeftHeader = ""
														sfooter=InStrRev(sNewFileName,"DRCReports")
														'msgbox"-"+ Cstr(sfooter)
														sfooter=sfooter+11
														'msgbox Cstr(sfooter)
														endxls=InStrRev(sNewFileName,".xls")
														'msgbox Cstr(endxls)
														.LeftFooter =  Mid(sNewFileName,sfooter,endxls-sfooter+4)
														.CenterFooter = "&P & of & &N"
														.Orientation = 2
														.Zoom = 95
														.LeftMargin =  app.Application.InchesToPoints(0.25)
														.RightMargin = app.Application.InchesToPoints(0.25)
														.TopMargin =  app.Application.InchesToPoints(0.75)
														.BottomMargin =app.Application.InchesToPoints(.8)
														.HeaderMargin = app.InchesToPoints(0)
														.FooterMargin = app.InchesToPoints(0.25)
														.PrintQuality = 600
											End With

											objWorkbook.Save
											app.Quit 
									 csFile.WriteLine "Revenue excel report formatting Done"
								end if
'Revenue excel report formatting END

If err.Number <> 0 then
    csFile.WriteLine "ERROR:Copy Failed"
    csFile.WriteLine "Error Number " & CStr(Err.Number) & " " & Err.Description	


else
    csFile.WriteLine "Copy Worked"
end if

	oxFile.delete
	osFile.delete
	If err.Number <> 0 then
	    	csFile.WriteLine "Delete Failed"
	    	csFile.WriteLine "Error Number " & CStr(Err.Number) & " " & Err.Description	
	else
    		csFile.WriteLine "Files deleted : " & oxFile & " and " & osFile
	end if


  
Set currentFolder = Nothing
Set objFSO = Nothing
Set file = Nothing
Set xmlDoc = Nothing
Set WshShell = Nothing
Set WshSysEnv = Nothing
'objFSO.CopyFile sFile, sNewFileName
csFile.WriteLine "End Date and Time: " & date() & " "& time()
----------------------------------------------END-------------------------------------------------------------

Please help ASAP
Thanks

Hi Guys, I have problem accessing web from excel using macros. This is the VB Source Code->


	VB:
	
 MetlinWeb1() 
     
    Dim IE As Object 
     
    Set IE = CreateObject("InternetExplorer.Application") 
    IE.Visible = True 
     
    IE.navigate "http://metlin.scripps.edu/metabo_batch.php" 
    Do Until IE.readyState = 4 
        DoEvents 
    Loop 
     
    Application.Wait (Now + TimeValue("0:00:01")) 
     'MsgBox "Done"
    IE.Visible = True 
     
    IE.Document.getElementById("masses").Value = 348.07 
     
    Application.Wait (Now + TimeValue("0:00:01")) 
     'MsgBox "Done"
    IE.Visible = True 
     
    IE.Document.getElementById("lstStuff").VALUE = Positive (##no error but Not working) 
     
    IE.Document.getElementById("lstOtherStuff").VALUE = "M+H:M+Na" (##no error but Not working) 
     
    IE.Document.getElementById("ppm").VALUE = "2" 
     
    IE.Document.getElementById("AminoAcid").VALUE = "N" (##Error And no id available on the html source code) 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Cheers
plasma33

Hi,

I am really new to using macros in excel. I have a file with 1000's of column and I need to plot as shown in the picture.
Here I have just shown few plots of how it looks. I believe writing a macro will definitely save me loads of time. Can anyone help me? ( x and y values varies a lot and I need to plot by switching 2 columns at once).

1 more question: Is there a way to eliminate E factor in the graph? ( 1.2 * 10^5 instead of 1.2E5 )

Thanks a lot,
SantoshFile.xlsxIV curve.jpg

I want to increment each cell by 1 using macros. That is I have different values in the cell, i have to append the number before the text. In first row, I have something named "Name1", here I have to append "1_" before Name1, i.e, the output should be like this, "1_Name1" and in the second row, I have something named "Name2", here I have to increment "2_" before Name2, i.e, the output should be like this, "2_Name2" and so on.

Hi i am New hear could you please tell me how to use macro i wanna like make a button or something could you please help or tell me a site where i can find the help from thanks

Dear All.
I have built an invoice that has two drop down boxes.
The invoice is on sheet 1. When you select Dept drop down
it VLookups info from sheet 2 and reduces the options in the
second drop down (staff no. also fed from sheet 2).
How do I create a button for print all macro that prints
all invoices from staff no. After you have chosen the Dept option.

i have a spreadsheet.. that i want to transfer data from sheet1 to sheet2 using macros and a shortcut like ctrl+x.. i want it to copy a row from sheet1 onto the next avaible row on sheet2 then delete that row on sheet1 that was just copyed.. the problem is that once it copies the row from sheet1 to sheet2.. it keeps overriting the same row. i want it to go to the next row avaible and so on. the code is below


	VB:
	
 Macro1() 
     '
     ' Macro1 Macro
     ' Macro recorded 17/05/2006 by c980857
     '
     ' Keyboard Shortcut: Ctrl+x
     '
    Selection.Copy 
    Sheets("Sheet2").Select 
    Rows("2:2").Select 
    ActiveSheet.Paste 
    Sheets("Sheet1").Select 
    Application.CutCopyMode = False 
    Selection.Delete Shift:=xlUp 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


HI friends,

I am new to Excel and also to the forum.
I have a query.
I have almost 300 rows in my excel sheet. I am hiding some of the rows depending on the value present in a cell in the first row.

For example if first row second colun cell contains Version1 I am hiding all the even rows in the sheets. If that value is Version 2 I am hiding all the odd rows in the sheet.

In first case I can see the row headers as 3,5,7..Can I change the header names to a sequence Ignoring the hidden rows(Like 2,3,4). Or else if it is not possible can I create some alias numbers for the row headers.

Also is there any possibility to change the row or column header using macros.

Thanks in advance
Pavan

hi,

i am using a list using form, where i have different items, i want to control that list using macro.

Plz help

Dear Expert,

I have difficulty in creating a .txt file and increase the number in it whenever I click a button.

For example,

First click : create .txt file and write 001 in the .txt file
Second click : overwrite 001 with 002
Third click : overwrite 002 with 003
and so on..

Is it possible to program using macro?

Please help!!!

Hi all,

i have different xls files of different data but with the same fields which i want to display in pivot table instead of creating pivot table for each file can i do it using macros.

if so kindly help me regarding this if possible with example code.

Thanks in advance,

regards,
venu.

I have a base spreadsheet program. Once data has been processed and results taken, I need to clear all data to use the program for fresh data, but before clearing i need to save a copy of the program
Can any one tell me how i can do this using macros
Thanks
legepe

Hi all,

Wondering if anyone can help. I've got a file for users to input data, which will then be manipulated and computed using macros (user has option to select which button (or macro) to run).

I would like to protect the worksheet (other than the input cells) but when I do so, the macros don't work, as expected (some amount of cutting & pasting involved.

I thought of building the macros to unprotect the sheet each time it is run, but this leaves little security as the users will still be able to unlock the worksheet by viewing the macro file itself.

Is there any way to Enable the macros, Protect the sheet AND still keep the password hidden at the same time?

Grateful if someone could help out. I've been cracking my head for some time on this little problem.

Many thanks and kindest regards to all. Cheers!

I am new to the forum.
I have a question on editing frequently used macros. Below is the macro which I use. The rows in bold are the rows that I have to manually edit after macros runs each time. I am wondering how to set up macros so that after it runs it automatically goes in & changes the sort row, highlight row & paste row.
The first row (sort row) goes down one number after each macro (i.e.-185 to 184...184 to 183....).
The second row (highlight row) goes down one number after each macro (i.e.-184 to 183...183 to 182...).
The third row (paste row) goes down 3 numbers after each macro (i.e.-887 to 884...884 to 881....).
Can anyone give me any suggestions on how to automate this, so that I don't manually have to change the sort criteria after each macro? Here is the macro:

ActiveWindow.ScrollRow = 153
ActiveWindow.ScrollRow = 138
ActiveWindow.ScrollRow = 128
ActiveWindow.ScrollRow = 117
ActiveWindow.ScrollRow = 111
ActiveWindow.ScrollRow = 104
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 83
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 1
Rows("1:336").Select
Selection.Sort Key1:=Range("A 185"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 82
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 89
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 97
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 102
ActiveWindow.ScrollRow = 106
ActiveWindow.ScrollRow = 111
ActiveWindow.ScrollRow = 115
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 128
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 137
ActiveWindow.ScrollRow = 139
ActiveWindow.ScrollRow = 142
ActiveWindow.ScrollRow = 145
ActiveWindow.ScrollRow = 148
ActiveWindow.ScrollRow = 150
ActiveWindow.ScrollRow = 153
ActiveWindow.ScrollRow = 157
ActiveWindow.ScrollRow = 161
ActiveWindow.ScrollRow = 164
ActiveWindow.ScrollRow = 168
ActiveWindow.ScrollRow = 172
ActiveWindow.ScrollRow = 175
ActiveWindow.ScrollRow = 179
ActiveWindow.ScrollRow = 182
ActiveWindow.ScrollRow = 186
ActiveWindow.ScrollRow = 190
ActiveWindow.ScrollRow = 193
ActiveWindow.ScrollRow = 190
ActiveWindow.ScrollRow = 186
ActiveWindow.ScrollRow = 183
ActiveWindow.ScrollRow = 180
ActiveWindow.ScrollRow = 179
ActiveWindow.ScrollRow = 178
ActiveWindow.ScrollRow = 176
ActiveWindow.ScrollRow = 175
ActiveWindow.ScrollRow = 174
Range("A184:E184").Select
Selection.Interior.ColorIndex = 35
ActiveWindow.ScrollRow = 171
ActiveWindow.ScrollRow = 170
ActiveWindow.ScrollRow = 165
ActiveWindow.ScrollRow = 161
ActiveWindow.ScrollRow = 156
ActiveWindow.ScrollRow = 146
ActiveWindow.ScrollRow = 135
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 106
ActiveWindow.ScrollRow = 96
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 1
Range("A1:E1").Select
Selection.Copy
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 98
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 119
ActiveWindow.ScrollRow = 131
ActiveWindow.ScrollRow = 145
ActiveWindow.ScrollRow = 157
ActiveWindow.ScrollRow = 172
ActiveWindow.ScrollRow = 185
ActiveWindow.ScrollRow = 197
ActiveWindow.ScrollRow = 208
ActiveWindow.ScrollRow = 219
ActiveWindow.ScrollRow = 233
ActiveWindow.ScrollRow = 246
ActiveWindow.ScrollRow = 256
ActiveWindow.ScrollRow = 268
ActiveWindow.ScrollRow = 279
ActiveWindow.ScrollRow = 289
ActiveWindow.ScrollRow = 297
ActiveWindow.ScrollRow = 307
ActiveWindow.ScrollRow = 316
ActiveWindow.ScrollRow = 327
ActiveWindow.ScrollRow = 338
ActiveWindow.ScrollRow = 352
ActiveWindow.ScrollRow = 363
ActiveWindow.ScrollRow = 374
ActiveWindow.ScrollRow = 382
ActiveWindow.ScrollRow = 391
ActiveWindow.ScrollRow = 398
ActiveWindow.ScrollRow = 402
ActiveWindow.ScrollRow = 409
ActiveWindow.ScrollRow = 413
ActiveWindow.ScrollRow = 417
ActiveWindow.ScrollRow = 423
ActiveWindow.ScrollRow = 427
ActiveWindow.ScrollRow = 431
ActiveWindow.ScrollRow = 435
ActiveWindow.ScrollRow = 439
ActiveWindow.ScrollRow = 444
ActiveWindow.ScrollRow = 449
ActiveWindow.ScrollRow = 453
ActiveWindow.ScrollRow = 457
ActiveWindow.ScrollRow = 460
ActiveWindow.ScrollRow = 463
ActiveWindow.ScrollRow = 465
ActiveWindow.ScrollRow = 467
ActiveWindow.ScrollRow = 470
ActiveWindow.ScrollRow = 474
ActiveWindow.ScrollRow = 478
ActiveWindow.ScrollRow = 482
ActiveWindow.ScrollRow = 485
ActiveWindow.ScrollRow = 487
ActiveWindow.ScrollRow = 491
ActiveWindow.ScrollRow = 496
ActiveWindow.ScrollRow = 498
ActiveWindow.ScrollRow = 502
ActiveWindow.ScrollRow = 505
ActiveWindow.ScrollRow = 507
ActiveWindow.ScrollRow = 508
ActiveWindow.ScrollRow = 511
ActiveWindow.ScrollRow = 512
ActiveWindow.ScrollRow = 513
ActiveWindow.ScrollRow = 515
ActiveWindow.ScrollRow = 517
ActiveWindow.ScrollRow = 520
ActiveWindow.ScrollRow = 524
ActiveWindow.ScrollRow = 527
ActiveWindow.ScrollRow = 530
ActiveWindow.ScrollRow = 533
ActiveWindow.ScrollRow = 534
ActiveWindow.ScrollRow = 538
ActiveWindow.ScrollRow = 539
ActiveWindow.ScrollRow = 542
ActiveWindow.ScrollRow = 545
ActiveWindow.ScrollRow = 548
ActiveWindow.ScrollRow = 550
ActiveWindow.ScrollRow = 553
ActiveWindow.ScrollRow = 554
ActiveWindow.ScrollRow = 556
ActiveWindow.ScrollRow = 557
ActiveWindow.ScrollRow = 559
ActiveWindow.ScrollRow = 560
ActiveWindow.ScrollRow = 563
ActiveWindow.ScrollRow = 564
ActiveWindow.ScrollRow = 565
ActiveWindow.ScrollRow = 568
ActiveWindow.ScrollRow = 571
ActiveWindow.ScrollRow = 574
ActiveWindow.ScrollRow = 576
ActiveWindow.ScrollRow = 579
ActiveWindow.ScrollRow = 581
ActiveWindow.ScrollRow = 583
ActiveWindow.ScrollRow = 587
ActiveWindow.ScrollRow = 589
ActiveWindow.ScrollRow = 591
ActiveWindow.ScrollRow = 594
ActiveWindow.ScrollRow = 597
ActiveWindow.ScrollRow = 600
ActiveWindow.ScrollRow = 604
ActiveWindow.ScrollRow = 608
ActiveWindow.ScrollRow = 611
ActiveWindow.ScrollRow = 612
ActiveWindow.ScrollRow = 615
ActiveWindow.ScrollRow = 616
ActiveWindow.ScrollRow = 620
ActiveWindow.ScrollRow = 622
ActiveWindow.ScrollRow = 623
ActiveWindow.ScrollRow = 624
ActiveWindow.ScrollRow = 626
ActiveWindow.ScrollRow = 630
ActiveWindow.ScrollRow = 633
ActiveWindow.ScrollRow = 635
ActiveWindow.ScrollRow = 637
ActiveWindow.ScrollRow = 641
ActiveWindow.ScrollRow = 644
ActiveWindow.ScrollRow = 645
ActiveWindow.ScrollRow = 649
ActiveWindow.ScrollRow = 652
ActiveWindow.ScrollRow = 653
ActiveWindow.ScrollRow = 656
ActiveWindow.ScrollRow = 657
ActiveWindow.ScrollRow = 660
ActiveWindow.ScrollRow = 663
ActiveWindow.ScrollRow = 665
ActiveWindow.ScrollRow = 668
ActiveWindow.ScrollRow = 671
ActiveWindow.ScrollRow = 674
ActiveWindow.ScrollRow = 676
ActiveWindow.ScrollRow = 678
ActiveWindow.ScrollRow = 681
ActiveWindow.ScrollRow = 682
ActiveWindow.ScrollRow = 685
ActiveWindow.ScrollRow = 686
ActiveWindow.ScrollRow = 687
ActiveWindow.ScrollRow = 689
ActiveWindow.ScrollRow = 690
ActiveWindow.ScrollRow = 691
ActiveWindow.ScrollRow = 693
ActiveWindow.ScrollRow = 694
ActiveWindow.ScrollRow = 696
ActiveWindow.ScrollRow = 697
ActiveWindow.ScrollRow = 698
ActiveWindow.ScrollRow = 701
ActiveWindow.ScrollRow = 702
ActiveWindow.ScrollRow = 704
ActiveWindow.ScrollRow = 705
ActiveWindow.ScrollRow = 707
ActiveWindow.ScrollRow = 709
ActiveWindow.ScrollRow = 711
ActiveWindow.ScrollRow = 712
ActiveWindow.ScrollRow = 716
ActiveWindow.ScrollRow = 718
ActiveWindow.ScrollRow = 720
ActiveWindow.ScrollRow = 722
ActiveWindow.ScrollRow = 726
ActiveWindow.ScrollRow = 728
ActiveWindow.ScrollRow = 730
ActiveWindow.ScrollRow = 731
ActiveWindow.ScrollRow = 737
ActiveWindow.ScrollRow = 739
ActiveWindow.ScrollRow = 742
ActiveWindow.ScrollRow = 745
ActiveWindow.ScrollRow = 749
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 757
ActiveWindow.ScrollRow = 760
ActiveWindow.ScrollRow = 761
ActiveWindow.ScrollRow = 764
ActiveWindow.ScrollRow = 765
ActiveWindow.ScrollRow = 767
ActiveWindow.ScrollRow = 770
ActiveWindow.ScrollRow = 771
ActiveWindow.ScrollRow = 772
ActiveWindow.ScrollRow = 774
ActiveWindow.ScrollRow = 775
ActiveWindow.ScrollRow = 776
ActiveWindow.ScrollRow = 778
ActiveWindow.ScrollRow = 781
ActiveWindow.ScrollRow = 782
ActiveWindow.ScrollRow = 783
ActiveWindow.ScrollRow = 785
ActiveWindow.ScrollRow = 786
ActiveWindow.ScrollRow = 789
ActiveWindow.ScrollRow = 790
ActiveWindow.ScrollRow = 791
ActiveWindow.ScrollRow = 794
ActiveWindow.ScrollRow = 796
ActiveWindow.ScrollRow = 797
ActiveWindow.ScrollRow = 800
ActiveWindow.ScrollRow = 801
ActiveWindow.ScrollRow = 804
ActiveWindow.ScrollRow = 805
ActiveWindow.ScrollRow = 807
ActiveWindow.ScrollRow = 808
ActiveWindow.ScrollRow = 809
ActiveWindow.ScrollRow = 812
ActiveWindow.ScrollRow = 813
ActiveWindow.ScrollRow = 815
ActiveWindow.ScrollRow = 816
ActiveWindow.ScrollRow = 819
ActiveWindow.ScrollRow = 820
ActiveWindow.ScrollRow = 822
ActiveWindow.ScrollRow = 823
ActiveWindow.ScrollRow = 824
ActiveWindow.ScrollRow = 826
ActiveWindow.ScrollRow = 827
ActiveWindow.ScrollRow = 828
ActiveWindow.ScrollRow = 830
ActiveWindow.ScrollRow = 831
ActiveWindow.ScrollRow = 834
ActiveWindow.ScrollRow = 835
ActiveWindow.ScrollRow = 837
ActiveWindow.ScrollRow = 838
ActiveWindow.ScrollRow = 839
ActiveWindow.ScrollRow = 841
ActiveWindow.ScrollRow = 842
ActiveWindow.ScrollRow = 844
ActiveWindow.ScrollRow = 845
ActiveWindow.ScrollRow = 846
ActiveWindow.ScrollRow = 848
ActiveWindow.ScrollRow = 849
ActiveWindow.ScrollRow = 850
ActiveWindow.ScrollRow = 853
ActiveWindow.ScrollRow = 855
ActiveWindow.ScrollRow = 856
ActiveWindow.ScrollRow = 857
ActiveWindow.ScrollRow = 860
ActiveWindow.ScrollRow = 853
ActiveWindow.ScrollRow = 845
ActiveWindow.ScrollRow = 838
ActiveWindow.ScrollRow = 827
ActiveWindow.ScrollRow = 816
ActiveWindow.ScrollRow = 802
ActiveWindow.ScrollRow = 789
ActiveWindow.ScrollRow = 774
ActiveWindow.ScrollRow = 756
ActiveWindow.ScrollRow = 737
ActiveWindow.ScrollRow = 711
ActiveWindow.ScrollRow = 679
ActiveWindow.ScrollRow = 648
ActiveWindow.ScrollRow = 616
ActiveWindow.ScrollRow = 585
ActiveWindow.ScrollRow = 559
ActiveWindow.ScrollRow = 538
ActiveWindow.ScrollRow = 520
ActiveWindow.ScrollRow = 505
ActiveWindow.ScrollRow = 491
ActiveWindow.ScrollRow = 479
ActiveWindow.ScrollRow = 471
ActiveWindow.ScrollRow = 463
ActiveWindow.ScrollRow = 453
ActiveWindow.ScrollRow = 446
ActiveWindow.ScrollRow = 438
ActiveWindow.ScrollRow = 428
ActiveWindow.ScrollRow = 422
ActiveWindow.ScrollRow = 411
ActiveWindow.ScrollRow = 398
ActiveWindow.ScrollRow = 386
ActiveWindow.ScrollRow = 371
ActiveWindow.ScrollRow = 357
ActiveWindow.ScrollRow = 345
ActiveWindow.ScrollRow = 331
ActiveWindow.ScrollRow = 320
ActiveWindow.ScrollRow = 308
ActiveWindow.ScrollRow = 298
ActiveWindow.ScrollRow = 290
ActiveWindow.ScrollRow = 280
ActiveWindow.ScrollRow = 274
ActiveWindow.ScrollRow = 265
ActiveWindow.ScrollRow = 260
ActiveWindow.ScrollRow = 253
ActiveWindow.ScrollRow = 249
ActiveWindow.ScrollRow = 245
ActiveWindow.ScrollRow = 241
ActiveWindow.ScrollRow = 234
ActiveWindow.ScrollRow = 230
ActiveWindow.ScrollRow = 227
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 222
ActiveWindow.ScrollRow = 220
ActiveWindow.ScrollRow = 217
ActiveWindow.ScrollRow = 215
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 212
ActiveWindow.ScrollRow = 211
ActiveWindow.ScrollRow = 207
ActiveWindow.ScrollRow = 204
ActiveWindow.ScrollRow = 200
ActiveWindow.ScrollRow = 196
ActiveWindow.ScrollRow = 190
ActiveWindow.ScrollRow = 189
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 185
ActiveWindow.ScrollRow = 183
ActiveWindow.ScrollRow = 180
ActiveWindow.ScrollRow = 178
ActiveWindow.ScrollRow = 176
ActiveWindow.ScrollRow = 172
ActiveWindow.ScrollRow = 170
ActiveWindow.ScrollRow = 167
ActiveWindow.ScrollRow = 163
ActiveWindow.ScrollRow = 159
ActiveWindow.ScrollRow = 156
ActiveWindow.ScrollRow = 160
ActiveWindow.ScrollRow = 168
ActiveWindow.ScrollRow = 178
ActiveWindow.ScrollRow = 185
ActiveWindow.ScrollRow = 193
ActiveWindow.ScrollRow = 198
ActiveWindow.ScrollRow = 207
ActiveWindow.ScrollRow = 212
ActiveWindow.ScrollRow = 219
ActiveWindow.ScrollRow = 228
ActiveWindow.ScrollRow = 235
ActiveWindow.ScrollRow = 246
ActiveWindow.ScrollRow = 263
ActiveWindow.ScrollRow = 283
ActiveWindow.ScrollRow = 309
ActiveWindow.ScrollRow = 342
ActiveWindow.ScrollRow = 370
ActiveWindow.ScrollRow = 449
ActiveWindow.ScrollRow = 482
ActiveWindow.ScrollRow = 550
ActiveWindow.ScrollRow = 581
ActiveWindow.ScrollRow = 609
ActiveWindow.ScrollRow = 633
ActiveWindow.ScrollRow = 649
ActiveWindow.ScrollRow = 664
ActiveWindow.ScrollRow = 679
ActiveWindow.ScrollRow = 690
ActiveWindow.ScrollRow = 698
ActiveWindow.ScrollRow = 708
ActiveWindow.ScrollRow = 715
ActiveWindow.ScrollRow = 720
ActiveWindow.ScrollRow = 726
ActiveWindow.ScrollRow = 733
ActiveWindow.ScrollRow = 741
ActiveWindow.ScrollRow = 750
ActiveWindow.ScrollRow = 759
ActiveWindow.ScrollRow = 765
ActiveWindow.ScrollRow = 768
ActiveWindow.ScrollRow = 770
ActiveWindow.ScrollRow = 772
ActiveWindow.ScrollRow = 775
ActiveWindow.ScrollRow = 778
ActiveWindow.ScrollRow = 782
ActiveWindow.ScrollRow = 785
ActiveWindow.ScrollRow = 789
ActiveWindow.ScrollRow = 793
ActiveWindow.ScrollRow = 797
ActiveWindow.ScrollRow = 800
ActiveWindow.ScrollRow = 802
ActiveWindow.ScrollRow = 804
ActiveWindow.ScrollRow = 805
ActiveWindow.ScrollRow = 808
ActiveWindow.ScrollRow = 809
ActiveWindow.ScrollRow = 811
ActiveWindow.ScrollRow = 815
ActiveWindow.ScrollRow = 819
ActiveWindow.ScrollRow = 824
ActiveWindow.ScrollRow = 830
ActiveWindow.ScrollRow = 833
ActiveWindow.ScrollRow = 834
ActiveWindow.ScrollRow = 835
ActiveWindow.ScrollRow = 838
ActiveWindow.ScrollRow = 841
ActiveWindow.ScrollRow = 844
ActiveWindow.ScrollRow = 846
ActiveWindow.ScrollRow = 850
ActiveWindow.ScrollRow = 852
ActiveWindow.ScrollRow = 856
ActiveWindow.ScrollRow = 860
Range("B887:F887").Select
ActiveSheet.Paste
End Sub

My operating system is WindowsXP & my version of Excel is OfficeXP. Thanks in advance for any help/suggestions.


No luck finding an answer? You could always try Google.