Slow VBScript to BOLD lines containing todays date in Excel

[BlueFin175]

Hi People,

I have a vbscript that sorts an Excel sheet with some 800k rows by a date column (Descending) bringing today to the top, then using findnext it cycles through each row bolding todays entire row, then it resorts and saves. Trouble is there may be up to say 30k rows with todays date and it seems to take forever to do this by one row at a time.

I am trying to find a way to sort by date decending bring all todays rows to the top, then find the entire block of rows in a range and bold them all at once rather than line by line. So I need to find a way to search the date column and find the row number where the date changes to other than today, store that row number, set the range accordingly then bold the entire range.

Can anyone please give me some pointers on how to find and store the row number when a cell value changes from a predetermined value. I feed the date in question to vbscript as an input Argument named:

ActDate = Wscript.Arguments.Item(3)

Please forgive me ignorance as I am very new to this whole vbscripting thing. Many thanks for any and all help.

Code I use is as follows:

     Set objRange = objXLWs.UsedRange
     Set objRange2 = objXLApp.Range("AL2")
     objRange.Sort objRange2, xlDescending, , , , , , xlYes

     objXLApp.Range("AL1").Select
     Set objRange = objXLApp.Range(objXLApp.Selection, objXLApp.Selection.End(xlDown))
     objrange.Select

     Set objTarget = objrange.Find(ActDate)

     If Not objTarget Is Nothing Then
     	strFirstAddress = objTarget.AddressLocal(False,False)

	objTarget.EntireRow.Font.Bold = True

       Do Until (objTarget Is Nothing)
     	Set objTarget = objRange.FindNext(objTarget)

    	strHolder = objTarget.AddressLocal(False,False)
    	If strHolder = strFirstAddress Then
           Exit Do
	End If

        if len(objTarget) = len(ActDate) then
           objTarget.EntireRow.Font.Bold = True
        end if
       Loop

     End If

 

[SkipVought]

Hi,

Select ALL the data and use the Conditional Formatting feature in Excel.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[BlueFin175]

Hi Skip, conditional formatting was not an option for me as I am using vbscript and not going anywhere near excel, thanks all the same however. I actually found a much faster way of doing it and have resolved my issue with the following code:

   ' set currentvalue as the latest body_date
   objXLApp.Range("AL2").Select
   CurrDateValue = DateValue(objXLApp.ActiveCell.Value)
   ActDate = DateValue(ActDate) 'convert the input argument ActDate to a Date format

   ' if the latest body_date = ActDate then cycle down the rows to find the first row where date changes
   If (CurrDateValue = ActDate) Then
     objXLApp.ActiveCell.Offset(1, 0).Select
     CompDateValue = DateValue(objXLApp.ActiveCell.Value)

'     Do While currentValue = compareValue
     Do While CurrDateValue = CompDateValue
      objXLApp.ActiveCell.Offset(1, 0).Select
      CompDateValue = DateValue(objXLApp.ActiveCell.Value)
     Loop

    ' set the row number to previous row as that will be the last row for today
    DateRow = (objXLApp.ActiveCell.Row)-1

    ' set the column address for bolding range
    LastCol = objXLApp.Cells(DateRow, icolumns).Address

    ' bold those rows within todays date range
    objXLApp.Range("A2",LastCol).Font.Bold = True
   End If

 

[SkipVought]

It can be done via code! Probably take a half-dozen LOC.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[strongm]

>I am using vbscript and not going anywhere near excel

So? You can apply conditional formatting from VBscript. Why would you not be able to?

 

[SkipVought]

you're manipulating other Excel objects in your code, so why not those CF objects as well?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[strongm]

I guess we lost them ...

 

[SkipVought]

Helloooooooooooooo............

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]