Results 1 to 8 of 8

Thread: [RESOLVED] Two Loops and apply formatting

  1. #1

    Thread Starter
    New Member
    Join Date
    Mar 2012
    Posts
    7

    Resolved [RESOLVED] Two Loops and apply formatting

    Hi,
    I hope I'm posting in the correct place. I write vbscripts in a text editor and run them from PowerShell with cscript so I'm not sure about a vb version.

    I am trying to open a workbook, loop through all worksheets, in each worksheet loop through all columns and look for a certain text string in the first row of every column, if it finds that string then format the entire column currency. the below code is what I have so far. When I WScript.Echo, it writes all the data in each column and row in each worksheet, so I know it's reading the data, but when I try to apply formatting, it does not. Also, for some reason I can't get it to save (maybe because the file hasn't changed since it won't format it won't save?). I set the workbook to visible to see what is happening but it opens and closes fast, so it's not performing how I wish.

    Here I'm looking for _num but the entire field name is Account_num; this is just a test run. it makes sense in my actual file where I need to distinguish qty from rev and format appropriately.

    Pleae see code below. any help appreciated. thanks

    Code:
    Option Explicit
    REM We use "Option Explicit" to help us check for coding mistakes
    
    REM the Excel Application
    Dim objExcel
    REM the path to the excel file
    Dim excelPath
    REM how many worksheets are in the current excel file
    Dim worksheetCount
    Dim counter
    REM the worksheet we are currently getting data from
    Dim currentWorkSheet
    REM the number of columns in the current worksheet that have data in them
    Dim usedColumnsCount
    REM the number of rows in the current worksheet that have data in them
    Dim usedRowsCount
    Dim row
    Dim column
    REM the topmost row in the current worksheet that has data in it
    Dim top
    REM the leftmost row in the current worksheet that has data in it
    Dim left
    Dim Cells
    REM the current row and column of the current worksheet we are reading
    Dim curCol
    Dim curRow
    REM the value of the current row and column of the current worksheet we are reading
    Dim word
    
    
    REM where is the Excel file located?
    excelPath = "H:\SMART\ReportStd\HLA\Book1.xlsx"
    
    WScript.Echo "Reading Data from " & excelPath
    
    REM Create an invisible version of Excel
    Set objExcel = CreateObject("Excel.Application")
    
    
    REM don't display any messages about documents needing to be converted
    REM from  old Excel file formats
    objExcel.DisplayAlerts = 0
    
    REM open the excel document as read-only
    REM open (path, confirmconversions, readonly)
    objExcel.Workbooks.open excelPath,false,true
    
    
    REM How many worksheets are in this Excel documents
    workSheetCount = objExcel.Worksheets.Count
    
    WScript.Echo "We have " & workSheetCount & " worksheets"
    
    REM Loop through each worksheet
    For counter = 1 to workSheetCount
    	WScript.Echo "-----------------------------------------------"
    	WScript.Echo "Reading data from worksheet " & counter & vbCRLF
    
    	Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(counter)
    	REM how many columns are used in the current worksheet
    	usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count
    	REM how many rows are used in the current worksheet
    	usedRowsCount = currentWorkSheet.UsedRange.Rows.Count
    
    	REM What is the topmost row in the spreadsheet that has data in it
    	top = currentWorksheet.UsedRange.Row
    	REM What is the leftmost column in the spreadsheet that has data in it
    	left = currentWorksheet.UsedRange.Column
    
    
    	Set Cells = currentWorksheet.Cells
    	REM Loop through each row in the worksheet 
    	For row = 0 to (usedRowsCount-1)
    		
    		REM Loop through each column in the worksheet 
    		For column = 0 to usedColumnsCount-1
    			REM only look at rows that are in the "used" range
    			curRow = row+top
    			REM only look at columns that are in the "used" range
    			curCol = column+left
    			REM get the value/word that is in the cell 
    			word = Cells(curRow,curCol).Value
    			REM display the column on the screen
    			WScript.Echo (word)
    		Next
    	Next
    
    	REM We are done with the current worksheet, release the memory
    	Set currentWorkSheet = Nothing
    Next
    
    objExcel.Workbooks(1).Close
    objExcel.Quit
    
    Set currentWorkSheet = Nothing
    REM We are done with the Excel object, release it from memory
    Set objExcel = Nothing

  2. #2
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,974

    Re: Two Loops and apply formatting

    Quote Originally Posted by apunc1 View Post
    Hi,
    I hope I'm posting in the correct place. I write vbscripts in a text editor and run them from PowerShell with cscript so I'm not sure about a vb version.
    In that case you aren't actually using VB, but VBScript.... so I've moved this thread from the 'VB6 and Earlier' forum to the 'ASP, VBScript' forum

  3. #3

    Thread Starter
    New Member
    Join Date
    Mar 2012
    Posts
    7

    Re: Two Loops and apply formatting

    Quote Originally Posted by si_the_geek View Post
    In that case you aren't actually using VB, but VBScript.... so I've moved this thread from the 'VB6 and Earlier' forum to the 'ASP, VBScript' forum
    thanks. I missed the 'vb script' in that forum title.

    I actually have the unedited code posted above (which i probably snagged from this site). it works, but I need to apply the formatting. I don't have the code on me right now, but I do a Mid function in a if then else statement to search for "_num" anywhere in the field in each column, select that column and apply formatting. there are no error messages but no formatting is applied. no changes are made to the file. I insert
    Code:
    objExcel.Workbooks(1).Save
    do i need need to do another loop for the formatting?

  4. #4

    Thread Starter
    New Member
    Join Date
    Mar 2012
    Posts
    7

    Re: Two Loops and apply formatting

    Ok here is teh actual script. I commented out the last four lines so I could see what it does, but it doesn't appear to loop at all. The excel file opens and the script finishes without doing anything.
    I've tried a few different ways and cannot get it to loop at all. i need it to loop through each column in the first row of each worksheet.
    Code:
    Option Explicit 
    REM We use "Option Explicit" to help us check for coding mistakes 
     REM the Excel Application 
    Dim objExcel 
    REM the path to the excel file 
    Dim excelPath 
    REM how many worksheets are in the current excel file 
    Dim worksheetCount 
    Dim counter 
    REM the worksheet we are currently getting data from 
    Dim currentWorkSheet 
    REM the number of columns in the current worksheet that have data in them 
    Dim usedColumnsCount 
    REM the number of rows in the current worksheet that have data in them 
    Dim usedRowsCount 
    Dim row 
    Dim column 
    REM the topmost row in the current worksheet that has data in it 
    Dim top 
    REM the leftmost row in the current worksheet that has data in it 
    Dim left 
    Dim Cells 
    REM the current row and column of the current worksheet we are reading 
    Dim curCol 
    Dim curRow 
    REM the value of the current row and column of the current worksheet we are reading 
    Dim word 
    Dim theString 
     REM where is the Excel file located? 
    excelPath = "H:\SMART\ReportStd\HLA\Book1.xlsx" 
     WScript.Echo "Reading Data from " & excelPath 
     REM Create an invisible version of Excel 
    Set objExcel = CreateObject("Excel.Application") 
    objExcel.Visible = True 
     REM don't display any messages about documents needing to be converted 
    REM from  old Excel file formats 
    objExcel.DisplayAlerts = 0 
     REM open the excel document as read-only 
    REM open (path, confirmconversions, readonly) 
    objExcel.Workbooks.open excelPath 
       
       
      
    REM Loop through each worksheet 
    For counter = 1 to workSheetCount 
     WScript.Echo "-----------------------------------------------" 
     WScript.Echo "Reading data from worksheet " & counter & vbCRLF 
      Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(counter) 
     REM how many columns are used in the current worksheet 
     usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count 
     REM how many rows are used in the current worksheet 
     usedRowsCount = currentWorkSheet.UsedRange.Rows.Count 
      REM What is the topmost row in the spreadsheet that has data in it 
     top = currentWorksheet.UsedRange.Row 
     REM What is the leftmost column in the spreadsheet that has data in it 
     left = currentWorksheet.UsedRange.Column 
      
     Set Cells = currentWorksheet.Cells 
     REM Loop through each row in the worksheet  
     For row = 0 to (usedRowsCount-1) 
       
      REM Loop through each column in the worksheet  
      For column = 0 to usedColumnsCount-1 
       REM only look at rows that are in the "used" range 
       curRow = row+top 
       REM only look at columns that are in the "used" range 
       curCol = column+left 
       REM get the value/word that is in the cell  
       word = Cells(curRow,curCol).Value 
       theString="_num" 
       If word = Mid(theString, 8, 4) Then 
        Columns(curCol).Select 
        Selection.NumberFormat = "$#,##0.00" 
          
       end if 
      Next  
     Next 
      REM We are done with the current worksheet, release the memory 
     Set currentWorkSheet = Nothing 
    Next 
    objExcel.Workbooks(1).Save 
    objExcel.Workbooks(1).Close 
     objExcel.Quit 
    Set objExcel = Nothing

  5. #5

    Thread Starter
    New Member
    Join Date
    Mar 2012
    Posts
    7

    Re: Two Loops and apply formatting

    OK now I have it opening the file, formatting the column correctly on the first worksheet, but it errors and stops on the second worksheet trying to find the Range again: "select method of range class failed"

    code below

    Code:
    Option Explicit
    ' We use "Option Explicit" to help us check for coding mistakes
    
    ' the Excel Application
    Dim objExcel
    ' the path to the excel file
    Dim excelPath
    ' how many worksheets are in the current excel file
    Dim worksheetCount
    Dim counter
    ' the worksheet we are currently getting data from
    Dim currentWorkSheet
    ' the number of columns in the current worksheet that have data in them
    Dim usedColumnsCount
    ' the number of rows in the current worksheet that have data in them
    Dim usedRowsCount
    Dim row
    Dim column
    ' the topmost row in the current worksheet that has data in it
    Dim top
    ' the leftmost row in the current worksheet that has data in it
    Dim left
    Dim Cells
    ' the current row and column of the current worksheet we are reading
    Dim curCol
    Dim curRow
    ' the value of the current row and column of the current worksheet we are reading
    Dim word
    Dim theString
    
    ' where is the Excel file located?
    excelPath = "H:\SMART\ReportStd\HLA\Book1.xlsx"
    
    WScript.Echo "Reading Data from " & excelPath
    
    ' Create an invisible version of Excel
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    
    ' don't display any messages about documents needing to be converted
    ' from  old Excel file formats
    objExcel.DisplayAlerts = 0
    
    ' open the excel document as read-only
    ' open (path, confirmconversions, readonly)
    objExcel.Workbooks.open excelPath,false,true
    
    
    ' How many worksheets are in this Excel documents
    workSheetCount = objExcel.Worksheets.Count
    
    WScript.Echo "We have " & workSheetCount & " worksheets"
    
    ' Loop through each worksheet
    For counter = 1 to workSheetCount
     WScript.Echo "-----------------------------------------------"
     WScript.Echo "Reading data from worksheet " & counter & vbCRLF
    
     Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(counter)
     ' how many columns are used in the current worksheet
     usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count
     ' how many rows are used in the current worksheet
     usedRowsCount = currentWorkSheet.UsedRange.Rows.Count
    
     ' What is the topmost row in the spreadsheet that has data in it
     top = currentWorksheet.UsedRange.Row
     ' What is the leftmost column in the spreadsheet that has data in it
     left = currentWorksheet.UsedRange.Column
    
    
     Set Cells = currentWorksheet.Cells
     ' Loop through each row in the worksheet 
     For row = 0 to (usedRowsCount-1)
      
      ' Loop through each column in the worksheet 
      For column = 0 to usedColumnsCount-1
       ' only look at rows that are in the "used" range
       curRow = row+top
       ' only look at columns that are in the "used" range
       curCol = column+left
       ' get the value/word that is in the cell 
       word = Cells(curRow,curCol).Value
       theString="_num" 
        If word= Mid(theString, 8, 4) Then 
        currentworksheet.cells.Select
        objexcel.Selection.NumberFormat = "$#,##0.00" 
       ' display the column on the screen
       WScript.Echo (word)
       end if
      Next
     Next
     ' We are done with the current worksheet, release the memory
     Set currentWorkSheet = Nothing
    Next
    objExcel.Workbooks(1).Save
    objExcel.Workbooks(1).Close
    
    objExcel.Quit
    Set objExcel = Nothing

  6. #6
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,974

    Re: Two Loops and apply formatting

    That is most likely to be because you haven't specified parent objects properly, here is one line where you got it wrong:
    Code:
       word = Cells(curRow,curCol).Value
    ...which (after a quick glance) should probably be:
    Code:
       word = currentworksheet.Cells(curRow,curCol).Value
    Once you fix all of the issues like that, it is likely to stop this kind of error.

  7. #7

    Thread Starter
    New Member
    Join Date
    Mar 2012
    Posts
    7

    Re: Two Loops and apply formatting

    I fixed that one and there was no change in how the script ran. I looked for other instances where I could specifiy the object but coudln't find any.

    Quote Originally Posted by si_the_geek View Post
    That is most likely to be because you haven't specified parent objects properly, here is one line where you got it wrong:
    Code:
       word = Cells(curRow,curCol).Value
    ...which (after a quick glance) should probably be:
    Code:
       word = currentworksheet.Cells(curRow,curCol).Value
    Once you fix all of the issues like that, it is likely to stop this kind of error.

  8. #8

    Thread Starter
    New Member
    Join Date
    Mar 2012
    Posts
    7

    Re: Two Loops and apply formatting

    FYI: below is the code that works

    Code:
    Option Explicit  
    Dim objExcel, excelPath, worksheetCount, counter, currentWorkSheet, usedColumnsCount, usedRowsCount, row, column, top  
    Dim left, Cells, curCol, curRow, word, theString, objWorkBook, objWorkSheets  
    excelPath = "H:\SMART\ReportStd\HLA\DNA Monthly Sales_2012-08.xlsx"  
    WScript.Echo "Reading Data from " & excelPath  
    Set objExcel = CreateObject("Excel.Application")  
    objExcel.Visible = False  
    objExcel.DisplayAlerts = 0  
    Set objWorkbook = objExcel.Workbooks.Open(excelPath)  
    objWorkSheets = objWorkBook.Sheets.Count  
    For counter = 1 to objWorkSheets  
    WScript.Echo "-----------------------------------------------"  
    WScript.Echo "Reading data from worksheet " & counter & vbCRLF   
    Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(counter)  
    usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count  
    usedRowsCount = currentWorkSheet.UsedRange.Rows.Count  
    top = currentWorksheet.UsedRange.Row  
    left = currentWorksheet.UsedRange.Column  
    Set Cells = currentWorksheet.Cells  
    For row = 0 to (usedRowsCount - 1)  
     For column = 0 to (usedColumnsCount - 1)  
      curRow = row+top  
      curCol = column+left  
      word = Cells(curRow,curCol).Value  
      If InStr(LCase(word), "_net") > 1 Then   
         With currentWorkSheet.Columns(curCol) 
              .NumberFormat = "$#,##0.00" 
    			'WScript.Echo (word)
           End With 
     End If 
     If InStr(LCase(word), "qty") > 1 Then   
         With currentWorkSheet.Columns(curCol) 
              .NumberFormat = "#,##0" 
    			'WScript.Echo (word)
           End With 
     End If   
     Next  
    Next   
    Next  
    Set currentWorkSheet = Nothing  
    objExcel.Workbooks(1).Save  
    objExcel.Workbooks(1).Close  
    objExcel.Quit  
    Set objExcel = Nothing

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width