Thread: Excel crash
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone[_2_] Jim Cone[_2_] is offline
external usenet poster
 
Posts: 1,549
Default Excel crash

This could be an improvement, but I have not tested it...
'---
Option Explicit ' first line at top of module.

Public Sub GenericoLast_R1()
'Dim App As New Excel.Application,
On Error GoTo RigaErrore
Dim SourceFile As Workbook
Dim SourceRange1 As Range, TargetRange1 As Range
Dim SourceRange2 As Range, TargetRange2 As Range
Dim SourceRange3 As Range, TargetRange3 As Range
Dim ExternalFileName As String, ExternalSheetName As String

'check if file exist
'If Not FileExists("C:\Users\PC\Documents\generico.xls") Then
' MsgBox "File not found", vbExclamation, "Attention..."
' GoTo RigaErrore
'Else

' Definitions
' -----------------------------------------
ExternalFileName = "C:\Users\PC\Documenti\generico.xls"
ExternalSheetName = "generico"
Set TargetRange1 = [Daily!A7:E7] ' Penultimate values
Set TargetRange2 = [Daily!A8:E8] ' last value
Set TargetRange3 = [Daily!B20:H33] ' TC2
' -----------------------------------------
Set SourceFile = Workbooks.Open(ExternalFileName)

'Import penultimate value
Set SourceRange1 = SourceFile.Worksheets(ExternalSheetName).Range("A1 ")
If Not IsEmpty(SourceRange1(2, 1)) Then
Set SourceRange1 = SourceRange1.Resize _
(SourceRange1.End(xlDown).Row - SourceRange1.Row + 1, 1)
End If
Set SourceRange1 = SourceRange1(SourceRange1.Rows.Count - 1).Resize(1, 6)
TargetRange1 = SourceRange1.Value

'Import last value
Set SourceRange2 = SourceFile.Worksheets(ExternalSheetName).Range("A1 ")
If Not IsEmpty(SourceRange2(2, 1)) Then
Set SourceRange2 = SourceRange2.Resize _
(SourceRange2.End(xlDown).Row - SourceRange2.Row + 1, 1)
End If
Set SourceRange2 = SourceRange2(SourceRange2.Rows.Count - 0).Resize(1, 6)
TargetRange2 = SourceRange2.Value

'Import TC2 values
Set SourceRange3 = SourceFile.Worksheets(ExternalSheetName).Range("A1 ")
If Not IsEmpty(SourceRange3(2, 1)) Then
Set SourceRange3 = SourceRange3.Resize _
(SourceRange3.End(xlDown).Row - SourceRange3.Row + 1, 1)
End If
Set SourceRange3 = SourceRange3(SourceRange3.Rows.Count - 13).Resize(14, 7)
TargetRange3 = SourceRange3.Value

SourceFile.Close
' App.Quit

'End If
' Kill "C:\Users\PC\Documents\generico.xls"
Exit Sub

RigaErro
MsgBox Err.Number & vbCr & Err.Description
End Sub
--
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware
(XL Companion add-in: compares, matches, counts, lists, finds, deletes...)




"JohnB"
wrote in message
. ..
Hello to everybody,
I am trying to develop a little application with Excel, even if I am a novice with Vba and every
time that I launch Excel 2007/Vista stop to work.
Basically I have an external Excel file and I want to import some values into my app.:
- import the last row (A:G range)
- import the penultima row (A:G range)
- import the last 14th rows (A:G range)
Below the code I am trying.
Any help also to improve the routine is really appreciated.
Thanks in advance and Regards
John


Public Sub GenericoLast()
Dim App As New Excel.Application, SourceFile As Object
Dim SourceRange1 As Range, TargetRange1 As Range
Dim SourceRange2 As Range, TargetRange2 As Range
Dim SourceRange3 As Range, TargetRange3 As Range
Dim ExternalFileName As String, ExternalSheetName As String

'check if file exist
If Not FileExists("C:\Users\PC\Documents\generico.xls") Then
MsgBox "File not found", vbExclamation, "Attention..."
GoTo RigaErrore
Else

' Definitions
' -----------------------------------------
ExternalFileName = "C:\Users\PC\Documenti\generico.xls"
ExternalSheetName = "generico"
Set TargetRange1 = [Daily!A7:E7] ' Penultimate values
Set TargetRange2 = [Daily!A8:E8] ' last value
Set TargetRange3 = [Daily!B20:H33] ' TC2
' -----------------------------------------
Set SourceFile = App.Workbooks.Open(ExternalFileName)

'Import penultimate value
Set SourceRange1 = SourceFile.Worksheets(ExternalSheetName).Range("A1 ")
If Not IsEmpty(SourceRange1(2, 1)) Then
Set SourceRange1 = SourceRange1.Resize _
(SourceRange1.End(xlDown).Row - SourceRange1.Row + 1, 1)
End If
Set SourceRange1 = SourceRange1(SourceRange1.Rows.Count - 1).Resize(1, 6)
TargetRange1 = SourceRange1.Value

'Import last value
Set SourceRange2 = SourceFile.Worksheets(ExternalSheetName).Range("A1 ")
If Not IsEmpty(SourceRange2(2, 1)) Then
Set SourceRange2 = SourceRange2.Resize _
(SourceRange2.End(xlDown).Row - SourceRange2.Row + 1, 1)
End If
Set SourceRange2 = SourceRange2(SourceRange2.Rows.Count - 0).Resize(1, 6)
TargetRange2 = SourceRange2.Value

'Import TC2 values
Set SourceRange3 = SourceFile.Worksheets(ExternalSheetName).Range("A1 ")
If Not IsEmpty(SourceRange3(2, 1)) Then
Set SourceRange3 = SourceRange3.Resize _
(SourceRange3.End(xlDown).Row - SourceRange3.Row + 1, 1)
End If
Set SourceRange3 = SourceRange3(SourceRange3.Rows.Count - 13).Resize(14, 7)
TargetRange3 = SourceRange3.Value

SourceFile.Close
App.Quit

End If
Kill "C:\Users\PC\Documents\generico.xls"

RigaErro
Exit Sub
End Sub