none
VB Script Question : Looping method is taking forever - any quicker ways? RRS feed

  • Question

  • Hi Folks -

    I have a rather simple VB Script that I use to modify an excel file for summation purposes after I transpose it from column to rows using batch methodology. After I add the formulas to the excel file, I need find any null values in Column E and delete the ENTIRE row.

    The file is upwards of 11k line and this loop technique takes about 10 minutes. Is there a quicker way out there that anyone could recommend?

    Set objExcel = CreateObject("Excel.Application")
    
    Dim objexcel
    Dim objworkbook1
    Dim LastCell1
    
    '::-- Declare argurments passed from batch script --::'
    Dim args, LEXPPATH, EXPNAME, EXT
    set args = Wscript.arguments
    
    LEXPPATH= args(0)
    EXPNAME= args(1)
    EXT= args(2)
    
    Set objworkbook1= objExcel.Workbooks.Open(LEXPPATH & EXPNAME & EXT)
    
    '::-- Get LastCell of EXPNAME --::'
    Set objWorksheet1 = objWorkbook1.Worksheets(EXPNAME)
    xlUp = -4162
    Set LastCell1 = objWorksheet1.Range("A" & objWorksheet1.Rows.Count).End(xlUp)
    
    '::-- Add formula to E1 --::'
    objWorkbook1.Worksheets(EXPNAME).Range("E1").Value = _
    	"=IF(COUNTIFS($A1:$A$" & LastCell1.Row & ",A1,$B1:$B$" & LastCell1.Row & ",B1,$C1:$C$" & LastCell1.Row & _
    		",C1)=1,SUMIFS($D$1:D1,$A$1:$A1,A1,$B$1:B1,B1,$C$1:$C1,C1),"""")"
    
    '::-- Drag Down Formula Column E --::'
    Set SourceRange = objWorksheet1.Range("E1:E1")
    Set FillRange = objWorksheet1.Range("E1:E" & LastCell1.Row)
    SourceRange.AutoFill FillRange
    
    '::-- Copy concatenated cells to Column B --::'
    objWorkbook1.Worksheets(EXPNAME).Range("E1:E" & LastCell1.Row).Copy
    objWorkbook1.Worksheets(EXPNAME).Range("E1:E" & LastCell1.Row).PasteSpecial -4163
    
    '::-- Loop through Column E searching for null value - if found then delete entire row --::'
    	Set objWorksheet1 = objWorkbook1.Worksheets(EXPNAME)
    	xlUp = -4162
    	m = objWorksheet1.Range("A" & objWorksheet1.Rows.Count).End(xlUp).Row
    	For r = m To 1 Step -1
    		If Not InStr(objWorksheet1.Range("E" & r), "") > 0 Then
    			objWorksheet1.Range("E" & r).EntireRow.Delete
    		End If
    	Next
    		
    '::-- Delete Column D with will move Column E to Column D --::'
    objWorkbook1.Worksheets(EXPNAME).Range("D:D").Delete
    
    '::-- Ensure dates are in yy-mmm format --::'
    objWorkbook1.Worksheets(EXPNAME).Range("C1:C" & LastCell1.Row).NumberFormat = "yy-mmm"
    
    objexcel.DisplayAlerts = False
    objworkbook1.save
    objworkbook1.close
    objExcel.Quit
    WScript.Quit 0

    Thank you so much!
    • Moved by Bill_Stewart Thursday, March 15, 2018 4:20 PM Move to more appropriate forum
    Sunday, March 4, 2018 12:19 PM

All replies

  • $Search = $Range.find("")

    $range is the column you want to search. "FindNext" will get the next blank column.

    The $search object will also contain the row index to use for deleting the row.

    For speed collect all row indexes and delete in reverse order after they are found.

    11k rows should take less than a minute.



    \_(ツ)_/

    Sunday, March 4, 2018 12:41 PM
  • Hmmm, I can't seem to get it to work...Any ideas?

    And there's no quicker way via VBS instead of powershell?

    Thanks!

    Thursday, March 15, 2018 10:40 AM
  • "Find" works in VBS.


    \_(ツ)_/

    Thursday, March 15, 2018 4:39 PM
  • Hello cdtakacs1,

    Besides Find method, I would suggest you set ScreenUpdating as false to close the screen update while delete the rows and set it back if you finished.

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Friday, March 16, 2018 6:05 AM
  • Hello cdtakacs1,

    Besides Find method, I would suggest you set ScreenUpdating as false to close the screen update while delete the rows and set it back if you finished.

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Yes that is an excellent point however, when the wb is not visible the screen updates are effectively disabled.

    One issue that is known to slow down access to Excel  through COM automation is calling Excel 32 bit from a 64  bit script.  THis has been improved in Excel 2016 but it can be somewhat slower that avoiding the 64-32 bit thunk.  If Office is 32 bit then run the script from a 32 bit session.


    \_(ツ)_/

    Friday, March 16, 2018 6:17 AM
  • Hello cdtakacs1,

    Has your original issue been resolved? If it has, I would suggest you mark the helpful reply as answer or provide your solution and mark as answer to close this thread. If not, please feel free to let us know your current issue.

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Tuesday, March 20, 2018 5:08 AM
  • Hi There -

    No I haven't been able to get the "find" command to work and then delete entire row once the "null" is found.

    I'm still plugging away but any help is appreciated. thank you!

    Saturday, March 31, 2018 1:57 PM
  • To find the end of the used area of a worksheet use the "UsedRange"

    lastrow = objWorkbook1.Worksheets(EXPNAME).UsedRange.Rows.Count
    objWorkbook1.Worksheets(EXPNAME).UsedRange.Rows(lastrow).EntireRow.Delete()


    \_(ツ)_/



    • Edited by jrv Saturday, March 31, 2018 2:20 PM
    Saturday, March 31, 2018 2:10 PM
  • Hello cdtajacs1,

    Please check if below code could work for you.

    Set objExcel = CreateObject("Excel.Application")
    objExcel.visible=true
    Dim objexcel
    Dim objworkbook1
    Dim LastCell1
    
    '::-- Declare argurments passed from batch script --::'
    
    LEXPPATH= "C:\Users\Admin\Desktop\TestFolder\"
    EXPNAME= "Sheet1"
    EXT= ".xlsx"
    
    Set objworkbook1= objExcel.Workbooks.Open(LEXPPATH & EXPNAME & EXT)
    
    '::-- Get LastCell of EXPNAME --::'
    Set objWorksheet1 = objWorkbook1.Worksheets(EXPNAME)
    xlUp = -4162
    Set LastCell1 = objWorksheet1.Range("A" & objWorksheet1.Rows.Count).End(xlUp)
    
    '::-- Add formula to E1 --::'
    objWorkbook1.Worksheets(EXPNAME).Range("E1").Value = _
    	"=IF(COUNTIFS($A1:$A$" & LastCell1.Row & ",A1,$B1:$B$" & LastCell1.Row & ",B1,$C1:$C$" & LastCell1.Row & _
    		",C1)=1,SUMIFS($D$1:D1,$A$1:$A1,A1,$B$1:B1,B1,$C$1:$C1,C1),"""")"
    
    '::-- Drag Down Formula Column E --::'
    Set SourceRange = objWorksheet1.Range("E1:E1")
    Set objWorksheet1 = objWorkbook1.Worksheets(EXPNAME)
    Set FillRange = objWorksheet1.Range("E1:E" & LastCell1.Row)
    SourceRange.AutoFill FillRange
    
    '::-- Copy concatenated cells to Column B --::'
    'objWorkbook1.Worksheets(EXPNAME).Range("E1:E" & LastCell1.Row).Copy
    'objWorkbook1.Worksheets(EXPNAME).Range("E1:E" & LastCell1.Row).PasteSpecial -4163
    
    '::-- Loop through Column E searching for null value - if found then delete entire row --::'
    	
    	objWorksheet1.Select
            Dim objResultRng
    	objWorkbook1.Worksheets(EXPNAME).Range("E" & LastCell1.Row).Select
            Const xlValues=-4163
            Const xlPrevious=2
    	Set objResultRng=FillRange.Find("",,xlValues,,,xlPrevious)
            While Not objResultRng Is Nothing
              objResultRng.EntireRow.Delete
              Set objResultRng = FillRange.FindPrevious
            Wend 
    		
    '::-- Delete Column D with will move Column E to Column D --::'
    'objWorkbook1.Worksheets(EXPNAME).Range("D:D").Delete
    
    '::-- Ensure dates are in yy-mmm format --::'
    'objWorkbook1.Worksheets(EXPNAME).Range("C1:C" & LastCell1.Row).NumberFormat = "yy-mmm"
    
    objexcel.DisplayAlerts = False
    objworkbook1.save
    objworkbook1.close
    objExcel.Quit
    WScript.Quit 0

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, April 4, 2018 7:35 AM
  • Hello cdtajacs1,

    Please check if below code could work for you.

    Set objExcel = CreateObject("Excel.Application")
    objExcel.visible=true
    Dim objexcel
    Dim objworkbook1
    Dim LastCell1
    
    '::-- Declare argurments passed from batch script --::'
    
    LEXPPATH= "C:\Users\Admin\Desktop\TestFolder\"
    EXPNAME= "Sheet1"
    EXT= ".xlsx"
    
    Set objworkbook1= objExcel.Workbooks.Open(LEXPPATH & EXPNAME & EXT)
    
    '::-- Get LastCell of EXPNAME --::'
    Set objWorksheet1 = objWorkbook1.Worksheets(EXPNAME)
    xlUp = -4162
    Set LastCell1 = objWorksheet1.Range("A" & objWorksheet1.Rows.Count).End(xlUp)
    
    '::-- Add formula to E1 --::'
    objWorkbook1.Worksheets(EXPNAME).Range("E1").Value = _
    	"=IF(COUNTIFS($A1:$A$" & LastCell1.Row & ",A1,$B1:$B$" & LastCell1.Row & ",B1,$C1:$C$" & LastCell1.Row & _
    		",C1)=1,SUMIFS($D$1:D1,$A$1:$A1,A1,$B$1:B1,B1,$C$1:$C1,C1),"""")"
    
    '::-- Drag Down Formula Column E --::'
    Set SourceRange = objWorksheet1.Range("E1:E1")
    Set objWorksheet1 = objWorkbook1.Worksheets(EXPNAME)
    Set FillRange = objWorksheet1.Range("E1:E" & LastCell1.Row)
    SourceRange.AutoFill FillRange
    
    '::-- Copy concatenated cells to Column B --::'
    'objWorkbook1.Worksheets(EXPNAME).Range("E1:E" & LastCell1.Row).Copy
    'objWorkbook1.Worksheets(EXPNAME).Range("E1:E" & LastCell1.Row).PasteSpecial -4163
    
    '::-- Loop through Column E searching for null value - if found then delete entire row --::'
    	
    	objWorksheet1.Select
            Dim objResultRng
    	objWorkbook1.Worksheets(EXPNAME).Range("E" & LastCell1.Row).Select
            Const xlValues=-4163
            Const xlPrevious=2
    	Set objResultRng=FillRange.Find("",,xlValues,,,xlPrevious)
            While Not objResultRng Is Nothing
              objResultRng.EntireRow.Delete
              Set objResultRng = FillRange.FindPrevious
            Wend 
    		
    '::-- Delete Column D with will move Column E to Column D --::'
    'objWorkbook1.Worksheets(EXPNAME).Range("D:D").Delete
    
    '::-- Ensure dates are in yy-mmm format --::'
    'objWorkbook1.Worksheets(EXPNAME).Range("C1:C" & LastCell1.Row).NumberFormat = "yy-mmm"
    
    objexcel.DisplayAlerts = False
    objworkbook1.save
    objworkbook1.close
    objExcel.Quit
    WScript.Quit 0

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    HI Terry - thank you!

    Unfortunately that method doesn't work for my VB Script. It has an issue with the select piece.

    Ill try to poke around and see whats going on. thanks!

    Tuesday, May 29, 2018 7:03 PM