Range Selection of Sorted Data Excel 2008

KMK · October 19, 2010, 5:14am

I have four columns of data that is ascending by column 2, resulting in 6 sections corresponding to 6 different values in column 2 {20, 100, 200, 500, 1000, 2000}. I want to copy all the rows of data for each section to separate worksheets, as shown below:

Sheet 1: Sheet 2: Sheet 3: Sheet 4:
0.2 20 2 5 0.2 20 2 5 0.3 100 5 7 0.6 200 9 12
0.8 20 3 4 0.8 20 3 4 0.9 100 5 8 1.2 200 9 11
1.4 20 3 5 1.4 20 3 5 1.6 100 5 7 2.0 200 10 13
0.3 100 5 7
0.9 100 5 8
1.6 100 5 7
0.6 200 9 12
1.2 200 9 11
2.0 200 10 13
etc.

If anyone can assist me with specifying the range of cells where column 2 = 20, 100, 200, etc., I will be sincerely grateful. I have been experimenting with find and advanced filter but I am stumped.

Thanks in advance –

bills · October 19, 2010, 7:03pm

Hi
This is what I use,There is probably a better way.

tell application "Microsoft Excel"
	activate
	activate object worksheet "Sheet1"
	set columnToTest to range "d:d" of active sheet -- adjust
	set cellCount to count of cells of columnToTest
	set usedRanges to used range of worksheet object of columnToTest
	set rowsCount to first row index of (get end cell cellCount of columnToTest direction toward the top)
	set lastCol to (first column index of usedRanges) + (count of columns of usedRanges)
	set formulaCells to get resize (cell 1 of column (lastCol) of active sheet) row size rowsCount
	set formula r1c1 of formulaCells to ¬
		"=SUM(RC[-4]:RC[-1])"
	activate object worksheet "Sheet1"
	replace range "b:b" of worksheet "Sheet1" what "20" replacement "10000" search order by rows look at whole
	
	sort range "e1" of worksheet "Sheet1" key1 (range "e1" of worksheet "Sheet1")
	
	set columnToTest to range "e:e" of active sheet -- adjust
	set maxvalueCutOff to 10000 -- adjust
	set cellCount to count of cells of columnToTest
	set usedRanges to used range of worksheet object of columnToTest
	set rowsCount to first row index of (get end cell cellCount of columnToTest direction toward the top)
	set lastCol to (first column index of usedRanges) + (count of columns of usedRanges)
	set formulaCells to get resize (cell 1 of column (lastCol + 2) of active sheet) row size rowsCount
	set formula r1c1 of formulaCells to ¬
		"=1/(rc" & (first column index of columnToTest) ¬
		& "<" & maxvalueCutOff & ")"
	
	try
		set sourceRange to entire row of (special cells formulaCells type cell type formulas value errors)
		activate object worksheet "Sheet2"
		
		set destRange to range "A1" of worksheet "Sheet2"
		
		copy range sourceRange destination destRange
	end try
	activate object worksheet "Sheet1"
	--this part deletes values from sheet1
	(*try
		delete range entire row of (special cells formulaCells type cell type formulas value errors)
	end try*)
	try
		delete range entire column of formulaCells
	end try
	
	replace range "b:b" of worksheet "Sheet1" what "10000" replacement "20" search order by rows look at whole
	replace range "b:b" of worksheet "Sheet2" what "10000" replacement "20" search order by rows look at whole
	activate object worksheet "Sheet2"
	delete range range "e:i" shift shift to left
	-----------------------------------------------------
	activate object worksheet "Sheet1"
	replace range "b:b" of worksheet "Sheet1" what "100" replacement "10000" search order by rows look at whole
	
	sort range "e1" of worksheet "Sheet1" key1 (range "e1" of worksheet "Sheet1")
	
	set columnToTest to range "e:e" of active sheet -- adjust
	set maxvalueCutOff to 10000 -- adjust
	set cellCount to count of cells of columnToTest
	set usedRanges to used range of worksheet object of columnToTest
	set rowsCount to first row index of (get end cell cellCount of columnToTest direction toward the top)
	set lastCol to (first column index of usedRanges) + (count of columns of usedRanges)
	set formulaCells to get resize (cell 1 of column (lastCol + 2) of active sheet) row size rowsCount
	set formula r1c1 of formulaCells to ¬
		"=1/(rc" & (first column index of columnToTest) ¬
		& "<" & maxvalueCutOff & ")"
	try
		set sourceRange to entire row of (special cells formulaCells type cell type formulas value errors)
		activate object worksheet "Sheet3"
		set destRange to range "A1" of worksheet "Sheet3"
		copy range sourceRange destination destRange
	end try
	activate object worksheet "Sheet1"
	try
		delete range entire column of formulaCells
	end try
	replace range "b:b" of worksheet "Sheet1" what "10000" replacement "100" search order by rows look at whole
	replace range "b:b" of worksheet "Sheet3" what "10000" replacement "100" search order by rows look at whole
	activate object worksheet "Sheet3"
	delete range range "e:i" shift shift to left
	--------------------------------------------------
	activate object worksheet "Sheet1"
	replace range "b:b" of worksheet "Sheet1" what "200" replacement "10000" search order by rows look at whole
	
	sort range "e1" of worksheet "Sheet1" key1 (range "e1" of worksheet "Sheet1")
	
	set columnToTest to range "e:e" of active sheet -- adjust
	set maxvalueCutOff to 10000 -- adjust
	set cellCount to count of cells of columnToTest
	set usedRanges to used range of worksheet object of columnToTest
	set rowsCount to first row index of (get end cell cellCount of columnToTest direction toward the top)
	set lastCol to (first column index of usedRanges) + (count of columns of usedRanges)
	set formulaCells to get resize (cell 1 of column (lastCol + 2) of active sheet) row size rowsCount
	set formula r1c1 of formulaCells to ¬
		"=1/(rc" & (first column index of columnToTest) ¬
		& "<" & maxvalueCutOff & ")"
	try
		set sourceRange to entire row of (special cells formulaCells type cell type formulas value errors)
		activate object worksheet "Sheet4"
		set destRange to range "A1" of worksheet "Sheet4"
		copy range sourceRange destination destRange
	end try
	activate object worksheet "Sheet1"
	try
		delete range entire column of formulaCells
	end try
	replace range "b:b" of worksheet "Sheet1" what "10000" replacement "200" search order by rows look at whole
	replace range "b:b" of worksheet "Sheet4" what "10000" replacement "200" search order by rows look at whole
	activate object worksheet "Sheet4"
	delete range range "e:i" shift shift to left
	-----------------------------------------------------------
	--returns sheet 1 to original state
	activate object worksheet "Sheet1"
	delete range range "e:e" shift shift to left
	sort range "b1" of worksheet "Sheet1" key1 (range "b1" of worksheet "Sheet1")
end tell

hope it helps
regards
bills

Browser: Safari 533.16
Operating System: Mac OS X (10.5)

mikerickson · October 19, 2010, 7:07pm

Have you considered using AdvancedFilter’s copy to other location option?

KMK · October 19, 2010, 7:27pm

bills - I will have to spend some time with your code - thanks in anticipation.

mikerickson - I have tried using advanced filter, setting column 2 as my criteria range. I was unsuccessful and couldn’t figure out how to select an entire row based on a single cell (column 2) criteria.

I figured out how to copy and paste the sections of raw data (I want to keep the original data in Sheet1) by searching for the next section’s column 2 value. I find the start row for the “100” data and assign the previous row to the end row of the “20” data section. However, my first attempt does not work for row counts greater than 99 (I crudely grab the string of the address of the foundCell). I have tired to interpret sample code on this forum, but I cannot figure out how to extract the row address and insert into a range for copying.

Here is my code:

(*f=20*)
	set searchFrequency to "100"
	set foundCell to (find searchRange what searchFrequency look in values look at whole search order by columns search direction search next without match case)
	set {colFound, row100Start_1, row100Start_2} to text items of (get address of foundCell without row absolute and column absolute)
	set row100Start to (get {row100Start_1, row100Start_2} as string as integer)
	
	set row20End to (row100Start - 1)
	set copy20Range to range ("A1:D" & row20End) of active sheet
	copy range copy20Range destination range "A1" of sheet "f20"

Thanks for any clarifications on row (or column) extraction from a cell address.

KMK · October 19, 2010, 9:01pm

first row index was what I was missing.

I’m still interested in doing an advanced filter copy. mikerickson, I can’t make it work following some of your previous posts. Do I still have to create a temporary copy of the criteria and place in criteria range or can criteria range be nested within the data range?

Thank you.

mikerickson · October 20, 2010, 5:30am

This uses AdvancedFilter. It adds a new sheet for each of the values in column B and copies the data to that new sheet.
AdvancedFilter requires a header row. This adds one and deletes it at the end.
The Criteria Range of an AdvancedFilter has to be separated from the data by a blank row.

tell application "Microsoft Excel"
	set sourceWorkbook to workbook "Workbook1.xls"
	set sourceSheet to worksheet "Sheet1" of sourceWorkbook
		
	tell sourceSheet
		insert into range (range "1:1") shift shift down -- insert temporary header row
		set headerCells to range ("A1:D1")
		set critrange to range ("G1:G2")
	end tell
	set value of headerCells to {"Header1", "Header2", "Header3", "Header4"} -- temporary headers
	
	set value of (cell 1 of critrange) to "Header2" -- crit range has header for column B
	
	-- define ranges
	set lastRow to first row index of (get end (cell -1 of (column 2 of sourceSheet)) direction toward the top)
	set datarange to get resize (range "A1" of sourceSheet) row size lastRow column size 4
	
	-- get list of values from column B without duplicates
	set ValueList to {}
	repeat with i from 2 to lastRow
		set rowValue to value of cell i of column 2 of sourceSheet
		if not (ValueList contains {rowValue}) then
			copy rowValue to end of ValueList
		end if
	end repeat
	
	--for each uniqe value in column B
	repeat with i from 1 to count of ValueList
		-- make new sheet
		set destinationSheet to (make new worksheet in sourceWorkbook)
		set name of destinationSheet to "Records_" & (item i of ValueList) -- set name for new sheet
		
		-- advanced filter to new sheet
		set value of cell 2 of critrange to item i of ValueList
		advanced filter datarange action filter copy criteria range critrange copy to range (range "A1:D1" of destinationSheet) without unique
		
		-- remove header row
		delete range (range "1:1" of destinationSheet) shift shift up
	end repeat
	
	-- clean up crit range and delete temp header row
	clear contents critrange
	delete range (range "1:1" of sourceSheet) shift shift up
end tell

rapdigital · January 16, 2019, 12:26pm

Is there any way to get the entire row of the sourceSheet to copy into the destinationSheet?

rapdigital · January 16, 2019, 11:06pm

For any one that is following and/or for my future ref

extending the temp headers and resize range was the solution

tell application "Microsoft Excel"
                     set sourceWorkbook to active workbook -- "Book1.xls"
                     set sourceSheet to worksheet "Sheet1" --of sourceWorkbook
                    
                     tell sourceSheet
                                    insert into range (range "1:1") shift shift down -- insert temporary header row
                                    set headerCells to range ("A1:AY1")
                                    set critrange to range ("ZZ1:ZZ2")
                     end tell
                     set value of headerCells to {"Header1", "Header2", "Header3", "Header4", "Header5", "Header6", "Header7", "Header8", "Header9", "Header10", "Header11", "Header12", "Header13", "Header14", "Header15", "Header16", "Header17", "Header18", "Header19", "Header20", "Header21", "Header22", "Header23", "Header24", "Header25", "Header26", "Header27", "Header28", "Header29", "Header30", "Header31", "Header32", "Header33", "Header34", "Header35", "Header36", "Header37", "Header38", "Header39", "Header40", "Header41", "Header42", "Header43", "Header44", "Header45", "Header46", "Header47", "Header48", "Header49", "Header50", "Header51", "Header52"} -- temporary headers
                    
                     set value of (cell 1 of critrange) to "Header2" -- crit range has header for column B
                    
                     -- define ranges
                     set lastRow to first row index of (get end (cell -1 of (column 2 of sourceSheet)) direction toward the top)
                     set datarange to get resize (range "A1" of sourceSheet) row size lastRow column size 51
                    
                     -- get list of values from column B without duplicates
                     set ValueList to {}
                     repeat with i from 2 to lastRow
                                    set rowValue to value of cell i of column 3 of sourceSheet
                                    if not (ValueList contains {rowValue}) then
                                                            copy rowValue to end of ValueList
                                    end if
                     end repeat
                    
                     --for each uniqe value in column B
                     repeat with i from 1 to count of ValueList
                                    -- make new sheet
                                    set destinationSheet to (make new worksheet in sourceWorkbook)
                                    set name of destinationSheet to "Records_" & (item i of ValueList) -- set name for new sheet
                                   
                                    -- advanced filter to new sheet
                                    set value of cell 2 of critrange to item i of ValueList
                                    advanced filter datarange action filter copy criteria range critrange copy to range (range "A1:AY1" of destinationSheet) without unique
                                    --advanced filter datarange action filter copy criteria range critrange copy to range --without unique
                                   
                                    -- remove header row
                                    delete range (range "1:1" of destinationSheet) shift shift up
                     end repeat
                    
                     -- clean up crit range and delete temp header row
                     clear contents critrange
                     delete range (range "1:1" of sourceSheet) shift shift up
end tell