Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Sorting an Excel 2010 Worksheet, finding a range, Coloring, then Resorting.

Status
Not open for further replies.

BlueFin175

Technical User
Feb 14, 2013
3
US
I am very new to this whole VBSCRIPT thing so please forgive me ignorance.

I have several very large CSV files (400k + Rows with say 30 columns) that I presently work with using ooRexx 4.1.0 I have recently figured how to save these as xlsx Excel 2010 files using vbscript. I now need to figure how to do the following:

Sort the entire sheet by column C2 descending, find the range of rows containing "E" (these will be the top say 500 rows after the sort), color ONLY the resulting entire rows RED, then resort by two columns (B2, AT2) Ascending, save and exit.

I have included a FileType = 2 param to indicate the LARGE files and I think I have the sort figured out, but have no clue how to find the range of only those rows at the top of the file containing "E" in column 3, coloring only those entire rows RED, and then resorting using TWO columns rather than just one (B2, AT2).

Can some kind soul please indicate how this may be done ? Presently I am using the FileType = 1 which reads the entire file and this takes a while on a large file.

Many thanks for any and all help, Fin.

I have the following code to so :

Code:
'~~> To execute CSV_TO_EXCEL.VBS InFile OutFile
'~~> Takes a while on large files

'~~> input parameters
FileType = Wscript.Arguments.Item(0)
InFile = Wscript.Arguments.Item(1)
OutFile = Wscript.Arguments.Item(2)

Dim objXLApp, objXLWb, objXLWs

Set objXLApp = CreateObject("Excel.Application")

objXLApp.Visible = False
objXLApp.DisplayAlerts = False

Set objXLWb = objXLApp.Workbooks.Open(InFile)

'~~> Working with Sheet1
Set objXLWs = objXLWb.Sheets(1)


'~~> Freeze the Pane for the Column Header Row
With objXLApp.ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
End With
objXLApp.ActiveWindow.FreezePanes = True

'~~> Autofit ALL columns
Set objRange = objXLWs.UsedRange
objRange.EntireColumn.Autofit()

If FileType = 1 then
'~~> Finds "E" in column 3 and colors entire row RED when found
    iRows = objRange.Rows.Count
    iColumns = objRange.Columns.Count
       For iR = 2 To iRows
           Select Case objRange.Item(iR, 3).Value
           Case "E"
           objRange.EntireRow(iR).Interior.ColorIndex = 3
           End Select
       Next

ElseIf FileType = 2 then
'~~> Sorts the ERROR field bringing "E" to the top
'~~> Finds the RANGE of cells, then colors entire row RED
     Set objRange = objWorksheet.UsedRange
     Set objRange2 = objExcel.Range("C2")
     objRange.Sort objRange2, xlDescending, , , , , , xlYes

ElseIf FileType = 3 then
    iRows = Selection.Rows.Count
    iColumns = Selection.Columns.Count
       For iR = 2 To iRows
           Select Case Selection.Item(iR, 2).Value
           Case "YELLOW"
           Selection.EntireRow(iR).Interior.ColorIndex = 6
           Case "ORANGE"
           Selection.EntireRow(iR).Interior.ColorIndex = 45
           Case "BLUE"
           Selection.EntireRow(iR).Interior.ColorIndex = 33
           End Select
       Next iR
End If

'~~> Save as Excel 2010 File (xlsx) to retain format
objXLWb.SaveAs OutFile, 51

objXLWb.Close (True)

Set objXLWs = Nothing
Set objXLWb = Nothing

objXLApp.Quit
Set objXLApp = Nothing
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top