Excel crash

[JohnB]

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"

RigaErrore:
Exit Sub
End Sub

 

[Jim Cone]

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

RigaErrore:
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" <[email protected]>
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"

RigaErrore:
Exit Sub
End Sub

 

[Donald Guillett]

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"

RigaErrore:
Exit Sub
End Sub

You may be overcomplicating this. Send your file(S). Special emphasis
on before/after
"If desired, send your file to dguillett @gmail.com I will only look
if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results."

 

[GS]

Another approach...

Public Sub GenericoLast_R1()
'Dim App As New Excel.Application,
On Error GoTo RigaErrore
Dim wkbSource As Workbook, wksSource As Worksheet
Dim rngTarget1 As Range, rngTarget2 As Range, rngTarget3 As Range,
rng As Range
Dim sSourceFile 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
' -----------------------------------------
sSourceFile = "C:\Users\PC\Documenti\generico.xls"
Set rngTarget1 = [Daily!A7:E7] ' Penultimate values
Set rngTarget2 = [Daily!A8:E8] ' last value
Set rngTarget3 = [Daily!B20:H33] ' TC2
' -----------------------------------------
Set wkbSource = Workbooks.Open(sSourceFile)
Set wksSource = wkbSource.Sheets("generico")

Set rng = wksSource.Range("A1")
If Not IsEmpty(rng(2, 1)) Then
Set rng = rng.Resize(rng.End(xlDown).Row - rng.Row + 1, 1)
' End If
'Import penultimate value
rngTarget1 = rng(rng.Rows.Count - 1).Resize(1, 6).Value
'Import last value
rngTarget2 = rng(rng.Rows.Count - 0).Resize(1, 6).Value
'Import TC2 values
rngTarget3 = rng(rng.Rows.Count - 13).Resize(14, 7).Value
End If
wkbSource.Close
' App.Quit

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

RigaErrore:
MsgBox Err.Number & vbCr & Err.Description
End Sub

 

[GS]

revision2...

Public Sub GenericoLast_R1()
'Dim App As New Excel.Application,
On Error GoTo RigaErrore
Dim wkbSource As Workbook, wksSource As Worksheet
Dim rngTarget1 As Range, rngTarget2 As Range, rngTarget3 As Range,
rng As Range
Dim sSourceFile As String
sSourceFile = "C:\Users\PC\Documenti\generico.xls"

'check if file exist
'If Not FileExists(sSourceFile) Then
' MsgBox "File not found", vbExclamation, "Attention..."
' GoTo RigaErrore
'Else

' Definitions
' -----------------------------------------
Set rngTarget1 = [Daily!A7:E7] ' Penultimate values
Set rngTarget2 = [Daily!A8:E8] ' last value
Set rngTarget3 = [Daily!B20:H33] ' TC2
' -----------------------------------------
Set wkbSource = Workbooks.Open(sSourceFile)
Set wksSource = wkbSource.Sheets("generico")

Set rng = wksSource.Range("A1")
If Not IsEmpty(rng(2, 1)) Then
Set rng = rng.Resize(rng.End(xlDown).Row - rng.Row + 1, 1)
' End If
'Import penultimate value
rngTarget1 = _
rng(rng.Rows.Count - 1).Resize(rngTarget1.Rows.Count, _
rngTarget1.Columns.Count).Value
'Import last value
rngTarget2 = _
rng(rng.Rows.Count - 0).Resize(rngTarget2.Rows.Count, _
rngTarget2.Columns.Count).Value
'Import TC2 values
rngTarget3 = _
rng(rng.Rows.Count - 13).Resize(rngTarget3.Rows.Count, _
rngTarget3.Columns.Count).Value
End If
wkbSource.Close
' App.Quit

'End If
' Kill sSourceFile
Exit Sub

RigaErrore:
MsgBox Err.Number & vbCr & Err.Description
End Sub

Note that this revision eliminates using the hard-coded values for
source range resizing. If the source/target ranges change change size
for any reason you won't have to update the code beyond revising the
range addresses to suit.

 

[JohnB]

Let me say many thanks to all of You guys for your helps.
All versions works greatly and no more Excel crash; Version 2 seems to be
really fast.

Again many many thanks.
Regards
John