Can somebody explain why I am getting the "Type mismatch: 'Cells'" run time error?
The error occurs on the following line
Set oRange =oWorkSheet2.Range(Cells(intRowFrom,intCol),Cells(intRowTo,intCol))
The nextline works but it is messy code because it involves changing a column number to a letter.
Set oRange = oWorkSheet2.Range(StartCell,EndCell)
It appears that the Cells feature is ideal for my task but I cannot make it work.
Another problem that I have is, the column needs to be pasted as a row. I assume I should be using pastespecial but have not mastered the syntax to be able to instruct it to tranform the selected data. .
I have ordered some VBScripting manuals but would appreciate any help prior to their arrival.
'****************** the full function is copied below **********************************
'#----------------------- begin Copy_column -------------------------------------
'###################################k/####################################################################################
'# Copy_column
'# Description:- Take the Application_Value column from multiple spreadsheets and consolidate into a single spreadsheet/worksheet
'#
'# Input parameters:- Sheet name, Old spreadsheet, new spreadsheet
'#
'#######################################################################################################################
Function Copy_column(inputFolderPath, Consolidated_Spreadsheet)
Dim oExcel, oWorkBook, oWorkSheet, oExcel2, oWorkBook2, oWorkSheet2
Dim iColumn_Total, Next_Free_Column, iColumn2, iColumn2_Total
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Open consolidated spreadsheet and establish next free row number
Set oExcel = CreateObject("Excel.Application")
Set oWorkBook = oExcel.Workbooks.Open(Consolidated_Spreadsheet)
Set oWorkSheet = oWorkBook.Worksheets(1)
oWorkbook.CheckCompatibility = False
oExcel.Application.visible = True
oExcel.Application.DisplayAlerts = False
oWorkSheet.Activate
' establish next available column
iCol_Total = oWorkSheet.UsedRange.columns.count
Next_Free_Col = iCol_Total + 1
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Open folder containing the individual spreadsheets
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (inputFolderPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName(objFile.Path) = "xls" Then
' Ready Excel for reading indiviual spreadsheets
Set oExcel2 = CreateObject("Excel.Application")
oExcel2.Application.visible = True
Set oWorkbook2 = oExcel2.Workbooks.Open(objFile.Path)
Set oWorkSheet2 = oWorkBook2.Worksheets(1)
oWorkbook2.CheckCompatibility = False
' establish columns/rows used
iColumn2_Total = oWorkSheet2.UsedRange.columns.count
iRow2_Total = oWorkSheet2.UsedRange.rows.count
' establish column number for Value and Field_Name
icolumn2 = 1
While iColumn2 <= iColumn2_Total
If oWorkSheet2.Cells(1, iColumn2) = "Value" Then
App_Value_column = iColumn2
End If
If oWorkSheet2.Cells(1, iColumn2) = "Field_Name" Then
Env_Var_column = iColumn2
End If
iColumn2 = iColumn2 + 1
Wend
' establish row number to be copied from/to
iRow2 = 1
While iRow2 <= iRow2_Total
If oWorkSheet2.Cells(iRow2, Env_Var_column) = "Eligible" Then
iRow_From = iRow2
End If
If oWorkSheet2.Cells(iRow2, Env_Var_column) = "Comment_L3" Then
iRow_To = iRow2
End If
iRow2 = iRow2 + 1
Wend
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Copy column cells to be pasted to consolidated worksheet
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' **********Temporary fix until I work out how to use the Cells option ******************
Select Case (App_Value_column)
Case 1
Column_Letter = "A"
Case 2
Column_Letter = "B"
Case 3
Column_Letter = "C"
Case 4
Column_Letter = "D"
Case 5
Column_Letter = "E"
Case 6
Column_Letter = "F"
Case 7
Column_Letter = "G"
Case 8
Column_Letter = "H"
End Select
StartCell = Column_Letter & iRow_From
EndCell = Column_Letter & iRow_To
Set oRange2 = oWorkSheet2.Range(StartCell,EndCell)
oRange2.Copy
' **********End of temporary fix until I work out how to use the Cells option ******************
'
' intCol = Cint(App_Value_column)
' intRowFrom = Cint(iRow_From)
' intRowTo = Cint(iRow_To)
' print intCol &" - " & intRowFrom & " - " & intRowTo ' values displayed 3 - 11 - 271
' Set oRange =oWorkSheet2.Range(Cells(intRowFrom,intCol),Cells(intRowTo,intCol)) ' This fails with a Type mismatch: Cells
' oRange.Copy
' Paste copied cells to consolidated worksheet
intNextColumn = CInt(Next_Free_Col)
oWorkSheet.Columns(intNextColumn).Select
oWorkSheet.Paste
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Next_Free_Col = Next_Free_Col + 1
oWorkBook2.Application.CutCopyMode = False
oWorkBook2.Close
Set oWorkSheet2 = Nothing
Set oWorkBook2 = Nothing
oExcel2.Quit
Set oExcel2 = Nothing
End If
Next
oExcel.Application.DisplayAlerts = True
oWorkBook.Save
oWorkBook.Close
Set oWorkSheet = Nothing
Set oWorkBook = Nothing
oExcel.Quit
Set oExcel = Nothing
End Function
'#---------------------------- end Copy_column_to_row -------------------------