Gettig Issue while automatiing Vlookup function in excel through VBscript

• Monday, March 12, 2012 8:05 PM

   

   
  

  0

  Hi, Below code is working fine in VBA, but its not working in VBS. Any help highly appriciate.

  I am trying to automate lot of manual work in Excel, to carter this i wrote below code but below code is not working in VBS. Saying " OBJECT REQUIRED FOR APPLICATION". Please suggest. Do let me know if you need anything.

  -----------------------------------------------------------------------------------------------------
  

  Dim lRow, vl_rowcount
  vl_rowcount = objworkbook2.sheets("Final").Rows.Count
  Msgbox vl_rowcount
  lRow = objworkbook2.Sheets("Final").Range("A" & vl_rowcount).End(xlUp).Row
  Msgbox lRow

  With objworkbook2.Sheets("Final").Range("W2:W" & lRow) = Application.WorksheetFunction.VLookup(.Range("A2:A" & lRow), objworkbook2.Sheets("Main").Range("A:G"), 7, 0)

  End with

  ------------------------------------------------------------------------------------------------------'

  Find below the entire code

  
  

  Dim objExcel
  Dim objWorkbook1
  Dim objWorkbook2
  Set objExcel = CreateObject("Excel.Application")
  objExcel.Visible = True
  
  '------------------ Copying the Cotents in OSR Template Start----------------------------
  Set objWorkbook1= objExcel.Workbooks.Open("C:\New Folder\Export.xls")
  Set objWorkbook2= objExcel.Workbooks.Open("C:\New Folder\OSRSortTemplate.xlsx")
  objWorkbook1.Sheets(1).UsedRange.Copy
  objWorkbook2.Sheets(1).Range("A1").PasteSpecial Paste =xlValues
  objWorkbook2.Sheets(2).Range("A1").PasteSpecial Paste =xlValues
  '------------------ Copying the Cotents in OSR Template End ----------------------------
  '------------------ Deleting Columns and Rows in OSR Main Sheet start ----------------------------
  objWorkbook2.Sheets(2).Range("1:1").EntireRow.Delete
  objWorkbook2.Sheets(2).Range("A:A").EntireColumn.Delete
  '------------------ Deleting Columns and Rows in OSR Main Sheet End ----------------------------
  '------------------ Making Pivot Table OSR Main Sheet start ----------------------------
  Const xlToLeft = -4159
  Const xlR1C1 = -4150
  Const xlDatabase  = 1
  Const xlPivotTableVersion12 = 3
  Const xlCount = -4112
  Const xlColumnField = 2
  Const xlRowField = 1
  Const xlup = -4162
  Const xlToRight = -4161
  

  Dim pivotSheet, p_Sheet, p_Range_Addr
  Set pivotSheet = objWorkbook2.Sheets.Add()
  p_Sheet = pivotSheet.Name
  'Msgbox p_Sheet
  

  Dim p_columcount, lastcolumn, lastcol
  Dim P_rowcount, lastrow
  p_columcount = objworkbook2.Sheets("Main").Columns.Count
  p_rowcount = objworkbook2.Sheets("Main").Rows.Count
  'Msgbox p_columcount & vbcrlf & p_rowcount
  
  lastcolumn = objworkbook2.Sheets("Main").Range("A1").End(xlToRight).Column
  lastrow = objworkbook2.Sheets("Main").Range("A" & p_rowcount).End(xlUp).Row
  'Msgbox lastcolumn & vbcrlf & lastrow
  
  p_Range_Addr = "R1C1:" & objWorkbook2.Sheets("Main").Cells(lastrow, lastcolumn).Address(True, True, xlR1C1)
  'Msgbox p_Range_Addr
  
  'Activeworkbook.PivotCaches.Create(xlDatabase,"R1C1:R100C30",xlPivotTableVersion12).CreatePivotTable("Sheet2!R3C1","MyTable")
  objWorkbook2.PivotCaches.Create(xlDatabase, "Main!" & p_Range_Addr, xlPivotTableVersion12).CreatePivotTable p_Sheet & "!R3C1", "PivotTable3"
  
  objWorkbook2.Sheets(p_Sheet).Select
  objWorkbook2.Sheets(p_Sheet).Cells(3, 1).Select
  pivotSheet.PivotTables("PivotTable3").AddDataField pivotSheet.PivotTables("PivotTable3").PivotFields("Server Name"), "Count of Server Name", xlCount
  With pivotSheet.PivotTables("PivotTable3").PivotFields("Patch")
          .Orientation = xlColumnField
          .Position = 1
     End With
  
  With pivotSheet.PivotTables("PivotTable3").PivotFields("Server Name")
          .Orientation = xlRowField
          .Position = 1
      End With
  '------------------ Making Pivot Table OSR Main Sheet End ----------------------------
  '------------------ Copying Pivot table sheet date to Final Sheet start ----------------------------
  Const xlDown = -4121
  Dim F_columcount, Flastcolumn, F_Range_Addr, DynamicRg
  Dim F_rowcount, Flastrow
  F_columcount = objworkbook2.sheets(p_Sheet).Columns.Count
  F_rowcount = objworkbook2.sheets(p_Sheet).Rows.Count
  'Msgbox F_columcount & vbcrlf & F_rowcount
  Flastcolumn = objworkbook2.sheets(p_Sheet).Range("A4").End(xlToRight).Column
  'Msgbox Flastcolumn
  Flastrow = objworkbook2.sheets(p_Sheet).Range("A" & F_rowcount).End(xlUp).Row
  'Msgbox Flastrow
  
  DynamicRg = objworkbook2.sheets(p_Sheet).Cells(Flastrow, Flastcolumn).address
  'Msgbox DynamicRg
  objworkbook2.sheets(p_Sheet).Range("A4:" & DynamicRg).Copy
  objWorkbook2.Sheets("Final").Range("A1").PasteSpecial
  
  '------------------ Copying Pivot table sheet date to Final Sheet End ----------------------------
  '------------------ Changing Format Cell in Final Sheet Start ----------------------------
  const xlGeneral = 1
  Const xlBottom = -4107
  Const xlContext = -5002
  
  Dim Fcell, lcell
  'Frow = objworkbook2.sheets("Final").Range("A" & F_rowcount).End(xlUp).Row
  Fcell = objworkbook2.sheets("Final").Range("B1").End(xlToRight).Column
  'Msgbox Fcell
  lcell = objworkbook2.sheets("Final").Cells(Fcell).address(false, false)
  'Msgbox lcell
  'Msgbox objworkbook2.sheets("Final").Range("B1:" & lcell).address
  

  With objworkbook2.sheets("Final").Range("B1:" & lcell)
          .HorizontalAlignment = xlGeneral
          .VerticalAlignment = xlBottom
          .WrapText = False
          .Orientation = 90
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
      End With
  '------------------ Changing Format Cell in Final Sheet End ----------------------------
  '------------------ Autofit Final Sheet Strat ----------------------------
  objworkbook2.sheets("Final").Cells.EntireColumn.AutoFit
  '------------------ Autofit Final Sheet End ----------------------------
  '------------------ Copying Column Header Sheet Infor Start ----------------------------
  Dim Ficell, licell
  Ficell = objworkbook2.sheets("Final").Range("B1").End(xlToRight).Column + 2
  'Msgbox Ficell
  licell = objworkbook2.sheets("Final").Cells(Ficell).address
  'Msgbox licell
  objworkbook2.sheets("column headers").Range("A1:Q1").Copy
  objWorkbook2.Sheets("Final").Range(licell).PasteSpecial
  objWorkbook2.Sheets("Final").Range(licell).ColumnWidth = 23.57
  '------------------ Copying Column Header Sheet Infor End ----------------------------
  '------------------ Vlookup in Final Sheet Start ----------------------------
  Dim Mycolnumber, MyColumnLetter
  Mycolnumber = objWorkbook2.Sheets("Final").Range("B1").End(xlToRight).Column + 10
  MsgBox Mycolnumber
  If Mycolnumber > 26 Then
  MyColumnLetter = Chr(Int((Mycolnumber - 1) / 26) + 64) & Chr(((Mycolnumber - 1) Mod 26) + 65)
   MsgBox MyColumnLetter
  Else
      MyColumnLetter = Chr(Mycolnumber + 64)
      MsgBox MyColumnLetter
  End If
  
  Dim lRow, vl_rowcount
  vl_rowcount = objworkbook2.sheets("Final").Rows.Count
  Msgbox vl_rowcount
  lRow = objworkbook2.Sheets("Final").Range("A" & vl_rowcount).End(xlUp).Row
  Msgbox lRow
  
  With objworkbook2.Sheets("Final").Range("W2:W" & lRow) = objWorkbook2.VLookup(.Range("A2:A" & lRow), objworkbook2.Sheets("Main").Range("A:G"), 7, 0)
  End With
  
  '------------------ Vlookup in Final Sheet End ----------------------------
  
  objWorkbook1.save
  objWorkbook2.save
  objWorkbook1.close
  objWorkbook2.close
  set objExcel=nothing
  
  

  
  

  • Reply
  • Quote