Monday 11 July 2022

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

 

0 comments:

Post a Comment