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

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

On Mar 12, 4:10*am, "JohnB" wrote:
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

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."

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

RigaErro
MsgBox Err.Number & vbCr & Err.Description
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

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

RigaErro
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.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

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