K
Kc-Mass
I have an Excel module that produces an error every other time run. If you
unload the module and start fresh it works perfectly. The second time it
fails; the third time it works perfectly, etc etc. It all revolves around a
reference to a range. I am new to Excel VBA and am perhaps doing the whole
reference wrong. I am now using range(Cells(),Cells())).
The module has a function that finds a certain value in column "A" and then
defines a range above that. At first I tried creating a variable like
"B2:F2382" complete with quotes and put that in a range reference like Set
rngOne = the variable, but Excel would have none of that.
When the module bombs it bombs on the line :
Set srcRange = xlBook1.Worksheets(strSheet1).Range(Cells(2, 2),
Cells(lngBottom, 6))
Any Ideas appreciated
Thx
Code follows
Sub MoveData()
'Set an instance of Excel and pointers for workbooks and sheets
Dim xlApp As Excel.Application
Dim xlBook1 As Excel.WorkBook
Dim xlBook2 As Excel.WorkBook
Dim xlSheet1 As Excel.Worksheet
Dim xlSheet2 As Excel.Worksheet
Dim strPath1 As String
Dim strPath2 As String
Dim strWBFile1 As String
Dim strWBFile2 As String
Dim strWholeFName1 As String
Dim strWholeFName2 As String
Dim lngBottom As Long
Dim srcRange As Range
Dim trgRange As Range
Dim strQuote As String
Dim strSheet1 As String
Dim strSheet2 As String
strPath1 = "C:\ApplicationDev\"
strWBFile1 = "LSPT Input_Northeast_12182006.xls"
strWBFile2 = "LSPTTemplate_Northeast_12182006.xls"
strWholeFName1 = strPath1 & strWBFile1
strWholeFName2 = strPath1 & strWBFile2
strSheet1 = "11i Catalyst Mismatch- 11i"
strSheet2 = "LSPT- Project Data"
Set xlApp = New Excel.Application
Set xlBook1 = xlApp.Workbooks.Open(strWholeFName1)
Set xlBook2 = xlApp.Workbooks.Open(strWholeFName2)
xlApp.Visible = True
Set xlSheet1 = xlBook1.Worksheets(strSheet1)
Set xlSheet2 = xlBook2.Worksheets(strSheet2)
xlSheet1.Activate
Debug.Print Now()
lngBottom = FindTopofZeroes(xlBook1, 3) - 1
Debug.Print lngBottom
Set srcRange = xlBook1.Worksheets(strSheet1).Range(Cells(2, 2),
Cells(lngBottom, 6))
Set trgRange = xlBook2.Worksheets(strSheet2).Range("B2")
xlSheet1.Activate
srcRange.Copy trgRange
Debug.Print Now()
'Lets do the cleanup
'Excel often won't close successfully without being made visible
xlApp.Visible = True
'Release the objects.
Set srcRange = Nothing
Set trgRange = Nothing
Set xlApp = Nothing
Set xlBook1 = Nothing
Set xlBook2 = Nothing
Set xlSheet1 = Nothing
Set xlSheet2 = Nothing
xlApp.Quit
End Sub
Function FindTopofZeroes(WB As WorkBook, WS As Long)
Dim rngA As Range
Dim lngHold As Long
With WB.Worksheets(WS).Columns(1)
Set rngA = .Find(What:="0.0.0.0.0", _
LookIn:=xlValues, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If rngA Is Nothing Then
FindTopofZeroes = 0
Else
FindTopofZeroes = rngA.Row
lngHold = rngA.Row
End If
End With
End Function
Function FindLastUsedRow(WB As WorkBook, WS As Long, Column1 As Long)
Dim rngA As Range
Dim lngHold As Long
With WB.Worksheets(WS).Columns(Column1)
Set rngA = .Find(What:=WhatWant, _
SearchDirection:=xlPrevious, _
LookIn:=xlValues, _
SearchOrder:=xlByRows)
If rngA Is Nothing Then
FindLastUsedRow = 0
Else
FindLastUsedRow = rngA.Row
lngHold = rngA.Row
End If
End With
End Function
unload the module and start fresh it works perfectly. The second time it
fails; the third time it works perfectly, etc etc. It all revolves around a
reference to a range. I am new to Excel VBA and am perhaps doing the whole
reference wrong. I am now using range(Cells(),Cells())).
The module has a function that finds a certain value in column "A" and then
defines a range above that. At first I tried creating a variable like
"B2:F2382" complete with quotes and put that in a range reference like Set
rngOne = the variable, but Excel would have none of that.
When the module bombs it bombs on the line :
Set srcRange = xlBook1.Worksheets(strSheet1).Range(Cells(2, 2),
Cells(lngBottom, 6))
Any Ideas appreciated
Thx
Code follows
Sub MoveData()
'Set an instance of Excel and pointers for workbooks and sheets
Dim xlApp As Excel.Application
Dim xlBook1 As Excel.WorkBook
Dim xlBook2 As Excel.WorkBook
Dim xlSheet1 As Excel.Worksheet
Dim xlSheet2 As Excel.Worksheet
Dim strPath1 As String
Dim strPath2 As String
Dim strWBFile1 As String
Dim strWBFile2 As String
Dim strWholeFName1 As String
Dim strWholeFName2 As String
Dim lngBottom As Long
Dim srcRange As Range
Dim trgRange As Range
Dim strQuote As String
Dim strSheet1 As String
Dim strSheet2 As String
strPath1 = "C:\ApplicationDev\"
strWBFile1 = "LSPT Input_Northeast_12182006.xls"
strWBFile2 = "LSPTTemplate_Northeast_12182006.xls"
strWholeFName1 = strPath1 & strWBFile1
strWholeFName2 = strPath1 & strWBFile2
strSheet1 = "11i Catalyst Mismatch- 11i"
strSheet2 = "LSPT- Project Data"
Set xlApp = New Excel.Application
Set xlBook1 = xlApp.Workbooks.Open(strWholeFName1)
Set xlBook2 = xlApp.Workbooks.Open(strWholeFName2)
xlApp.Visible = True
Set xlSheet1 = xlBook1.Worksheets(strSheet1)
Set xlSheet2 = xlBook2.Worksheets(strSheet2)
xlSheet1.Activate
Debug.Print Now()
lngBottom = FindTopofZeroes(xlBook1, 3) - 1
Debug.Print lngBottom
Set srcRange = xlBook1.Worksheets(strSheet1).Range(Cells(2, 2),
Cells(lngBottom, 6))
Set trgRange = xlBook2.Worksheets(strSheet2).Range("B2")
xlSheet1.Activate
srcRange.Copy trgRange
Debug.Print Now()
'Lets do the cleanup
'Excel often won't close successfully without being made visible
xlApp.Visible = True
'Release the objects.
Set srcRange = Nothing
Set trgRange = Nothing
Set xlApp = Nothing
Set xlBook1 = Nothing
Set xlBook2 = Nothing
Set xlSheet1 = Nothing
Set xlSheet2 = Nothing
xlApp.Quit
End Sub
Function FindTopofZeroes(WB As WorkBook, WS As Long)
Dim rngA As Range
Dim lngHold As Long
With WB.Worksheets(WS).Columns(1)
Set rngA = .Find(What:="0.0.0.0.0", _
LookIn:=xlValues, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If rngA Is Nothing Then
FindTopofZeroes = 0
Else
FindTopofZeroes = rngA.Row
lngHold = rngA.Row
End If
End With
End Function
Function FindLastUsedRow(WB As WorkBook, WS As Long, Column1 As Long)
Dim rngA As Range
Dim lngHold As Long
With WB.Worksheets(WS).Columns(Column1)
Set rngA = .Find(What:=WhatWant, _
SearchDirection:=xlPrevious, _
LookIn:=xlValues, _
SearchOrder:=xlByRows)
If rngA Is Nothing Then
FindLastUsedRow = 0
Else
FindLastUsedRow = rngA.Row
lngHold = rngA.Row
End If
End With
End Function