APPLY AND DRAG THE FORMULA IN EXCEL USING VBS SCRIPT

                              APPLY  AND DRAG  THE FORMULA IN EXCEL USING VBS SCRIPT

In this Article, we are discussing about how we can use VBS Script to Apply formula on a Excel Sheet and drag the formula down the whole column.

We got different types of methods for that and they are as follows :

Three Methods :

M1:  Copy-Paste

M2:  Fill Down

M3:  Keystrokes

___________________________________________________________________________________

HERE :

' On error resume Next

' set args = WScript.Arguments

' vExcelFilePath = args.Item(0)

' vLogPath = args.Item(1)

 

'!!!!!!!STATIC PATH_INFO

 

vFilePath = "C:\Users\Lav Tiwari\Desktop\PRACTICE\Emp.xlsx"

vTabName = "Sheet1"                                                                                              

vLogPath = "C:\Users\Lav Tiwari\Documents\practiseOL1\Log.txt"

 

MsgBox("FilePath :" & vFilePath & vbCrLf & " TabName :" & vTabName & vbCrLf & " vLogPath :" & vLogPath)

 

'!!!!!!!!!!!!!! Create Object of Log File

 

Set objFS=CreateObject("Scripting.FileSystemObject")

Set FSO_Handle = objFS.OpenTextFile(vLogPath,8,True)

 

Set objData = Nothing

 

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

 

objExcel.DisplayAlerts = False

 

Set objData = objExcel.Workbooks.Open(vFilePath,False) 

FSO_Handle.WriteLine(Now & "Excel Operation  has been completed successfully " )

objExcel.windowstate = -4137

objExcel.Calculation = x1Manual

objData.Worksheets(vTabName).Activate

 

 

Dim RowCount

objData.Worksheets(vTabName).Activate

RowCount=objData.Worksheets(vTabName).UsedRange.Rows.Count

MsgBox("Last Row :" & RowCount)

 

 

' Performing And Dragging Formula

 

‘!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' Method 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

 

 vColFormula = "=CONCAT(A2,""  "",B2)"

 objData.Worksheets(vTabName).Range("K2:K"& RowCount).Formula = vColFormula

 MSGBOX("K2:K"& SRowCount & vbCrlf & "Formula Applied")

                

  wscript.sleep 500

  objData.Worksheets(vTabName).Range("I2:I"& RowCount).Copy

  wscript.sleep 500                                                                               

  objData.Worksheets(vTabName).Range("I2:I"& RowCount).PasteSpecial -4104

  MsgBox("I2:I"& RowCount & " M1 : Formula CoPas OP Done")

 

   !!!!!!!!!!!!!!!!!!!!!!!!!!!!' Method 2!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

 

  WScript.Sleep 600

  objData.Worksheets(vTabName).Activate

  vPCECount = objData.worksheets(vTabName).UsedRange.Rows.Count

  objData.worksheets(vTabName).Activate

  objExcel.ActiveSheet.Range("K2:K" & vPCECount).Filldown                                           ' Method 2

  MsgBox(" M2 : DragFill OP Done")

  

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' Method 3!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  

    WScript.Sleep 500

    objData.Worksheets(vTabName).Activate

    vPCECount = objData.worksheets(vTabName).UsedRange.Rows.Count

    objData.worksheets(vTabName).Activate

    objExcel.ActiveSheet.Range("K2:K" & vPCECount).Select

    set mySendKeys = CreateObject("wscript.shell")

    mysendkeys.SendKeys("^(d)")                                                                  

    MsgBox("M3 : Send Key OP Successful")

   

 

   

  

 

    If Err.Number <> 0 Then

               FSO_Handle.WriteLine(Now & "Excel Operation | FormulaNdDrag.vbs | Error | " & Err.Number & ":" & Err.Description )

              vStatus = "Fail"

    Else

    FSO_Handle.WriteLine(Now & "Excel Operation | FormulaNdDrag.vbs has been completed succesfully " )

               vStatus ="Pass"

           

    End If

    MsgBox("Status-: " & vStatus )

   

    ' WScript.StdOut.WriteLine vStatus               ' for automation purposes

   

    On Error Goto 0

   

    WScript.Quit

   

    FSO_Handle.Close()

   

    'Autoclose message box in vbs Script

   

    Function MegaBox_QC(p1)

                                CreateObject("Wscript.Shell").Popup p1 , 3 , "Qc Robo" , 4 + 32

    End Function

 

Read More

                            Print Mutiplication Table From 1 to 100 on Excel Sheet 

*Its preferrable to use Notepad++

1. Make a new Excel file with  sheet "Sheet 1".

2. Make a Log file "Log.txt" for storing Logs .

3.Open Notepad++ , open a new blank file and Name it say "PrintMulti1to100.vbs " . Note : ".vbs" extension and file type "All" is important to write in vbs scrpit

4. Now Write Following Code in the notepad++ file created in Step 3 :

___________________________________________________________________________________    

On error resume Next

set args = WScript.Arguments

vExcelFilePath = args.Item(0)

vLogPath = args.Item(1)

 

'!!!!!!! STATIC PATH_INFO

 

vExcelFilePath = "C:\Users\Lav Tiwari\Documents\practiseOL1\Print.xlsx"

vExcelTabName = "Sheet1"                                                                                                   

vLogPath = "C:\Users\Lav Tiwari\Documents\practiseOL1\Log.txt"

 

MsgBox("Email To :" & vExcelFilePath & vbCrLf &  " vExcelTabName :" & vExcelTabName & vbCrLf &  " vLogPath :" & vLogPath)

 

'!!!!!!!!!!!!!! Create Object of Log File

 

Set objFS=CreateObjects("Scripting.FileSystemObject")

Set FSO_Handle = objFS.OpenTextFile(vLogPath,8,True)

 

 Set objPasteData = Nothing

Set objRawData = Nothing

 

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

 

objExcel.DisplayAlerts = False

 

Set ObjRawData = objExcel.Workbooks.Open(vExcelFilePath,False)

 

FSO_Handle.WriteLine(Now &"Excel Operation has been completed successfully ")

objExcel.windowstate = -4137

 

ObjRawData.Worksheets(vExcelTabName).Activate

 

‘ !!!!!!!!  Logic 1 : Print 1 to 100 

 

For i=1 to 100

' ObjRawData.Worksheets(vExcelTabName).Cells(i,1).Value = i         ' Print Along the Column

' ObjRawData.Worksheets(vExcelTabName).Cells(1,i).Value = i         ' Print in the Row            

ObjRawData.Worksheets(vExcelTabName).Range("A"& i).Value = i  ' Using Range Syntax

' MsgBox(i)

Next

 

 ______________________________________________________________________________

‘ !!!!!!!! Logic 2 : To print multiplication table from 1 to 100

 

For j=1 to 100

For i=1 to 10

                                                                                                                                       ObjRawData.Worksheets(vExcelTabName).Cells(i,j).Value =  i*j                   

' MsgBox(i)

Next

Next

______________________________________________________________________________ 

‘ !!!!!!! Logic 3 : Table from 1 to 100 in  a * b = c format with “ Table of “ Title

                                                                                                   

For j=1 to 100

ObjRawData.Worksheets(vExcelTabName).Cells(1,j).Value = "Table of =" & j

 For i=1 to 10

' ObjRawData.Worksheets(vExcelTabName).Cells(i,1).Value = i

' ObjRawData.Worksheets(vExcelTabName).Cells(1,i).Value = i

ObjRawData.Worksheets(vExcelTabName).Cells(i+1,j).Value = i &" * "& j &" = "& i*j    

' MsgBox(i)  

Next

Next

 

______________________________________________________________________________ 

‘ !!!!! Logic 4 -:  with condition - odd multiples only

 

For j=1 to 100

ObjRawData.Worksheets(vExcelTabName).Cells(1,j).Value = "Table of =" & j

 

For i=1 to 10

 if i Mod 2 <> 0 Then    ‘ (if i Mod 2 = 0 for Even )

  'ObjRawData.Worksheets(vExcelTabName).Cells(i,1).Value = i

  'ObjRawData.Worksheets(vExcelTabName).Cells(1,i).Value = i

ObjRawData.Worksheets(vExcelTabName).Cells(i+1,j).Value =  i & " * " & j & " = " & i*j 

End if                                                                           

' MsgBox(i)

 Next

 Next

 

_____________________________________________________________________________ 

‘ !!!!! Logic 5 : Table from 1 to 100 in a * b = c format with “ Table of “ Title Coloured

 

For j=1 to 100

 

ObjRawData.Worksheets(vExcelTabName).Cells(1,j).Value = "Table of =" & j

ObjRawData.Worksheets(vExcelTabName).Cells(1,j).Interior.ColorIndex = 37

 

For i=1 to 10

 

 'ObjRawData.Worksheets(vExcelTabName).Cells(i,1).Value = i

 'ObjRawData.Worksheets(vExcelTabName).Cells(1,i).Value = i

 

ObjRawData.Worksheets(vExcelTabName).Cells(i+1,j).Value = i &" * "& j &" =" & i*j    

 

 ‘MsgBox(i)

 Next

 Next

 

ObjRawData.Save

 ObjRawData.Close True

 

'Error Handling in VBS

 

If Err.Number <> 0 Then

 

    FSO_Handle.WriteLine(Now & "Excel Operation | ExcelPrint1to100.vbs | Error | " &                  Err.Number & ":" & Err.Description)

              vStatus = "Fail"

Else

    FSO_Handle.WriteLine(Now & "Excel Operation | ExcelPrint1to100.vbs has been  completed succesfully ")

               vStatus ="Pass"

              

End If

    MsgBox("Status-: " & vStatus )

    WScript.StdOut.WriteLine vStatus

   

On Error Goto 0

   

    WScript.Quit

   

    FSO_Handle.Close()

   

'Autoclose Message Box In Vbs Script

 

    Function MegaBox_QC(p1)

 

                     CreateObject("Wscript.Shell").Popup p1 , 3 , "Qc Robo" , 4 + 32

    End Function

 

 

_________________________________________________________________________________

Note:  '  Sign before a code line makes it comment line , shortcut " ctrl + k " in Notepad++ to                    make  something comment or "Shift + ctrl + k" reverse it .

_________________________________________________________________________________

 RESULT : 

 

Read More