ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Is there a better method to achieve this? (https://www.excelbanter.com/excel-programming/273964-re-there-better-method-achieve.html)

Les[_4_]

Is there a better method to achieve this?
 
Hi James

Thanks for response

Unfortunately, I can't manage to make your suggested code work. It
seems like it should, and breaking at various points and examining
variables, I am surprised to end up with only an empty target
workbook.

Although all the variables show correct data, I just end up with
blank ranges in the target workbook - plus, I can't figure out why
either.

Sorry for not being able to make it work, as your code fits
precisely with what I had hoped for - a more logical and concise
way of doing it.

regards,
--
Les Hay, Livingston. Scotland
"Jim Becker" wrote in message
...
Here's an alternative, untested:

Sub TransferFileData(fn As String)
Dim Source As Workbook, Target As Workbook
Dim i As Integer, tmpRange As Variant '(String)

Unload frmFileGet
frmReplaceData.Show vbModeless

DoEvents

Set Target = ActiveWorkbook

Set Source = Workbooks.Open(FileName:=fn)

For i = 2 To Worksheets.Count - 2
For Each tmpRange In Array("C9:D38", "F9:G38", _
"J9:V38", "X9:Y38", "AA9:AA38")
Target.Worksheets(i).Range(tmpRange) = _
Source.Worksheets(i).Range(tmpRange)
Next tmpRange
Next i

Source.Close SaveChanges:=False

Unload frmReplaceData
End Sub

--
Hope this helps,
James dot Becker at NCR dot com
~
~
~
:wq!

"Les" wrote in message
...
Hi

I have created a sub routine in my workbook with the intention

of
allowing the replacing of current data from a similar workbook
(same structure).

Although this sub does work, and as far as I can tell so far,
without any problem, I feel it is perhaps a little cumbersome.

I have searched through the help files to try to find some

sort of
statements better equipped to achieve this but can't find
anything.

Is there a more efficient method to do this? Is it best to

open
the source workbook and copy?

============================================
Sub TransferFileData(fn As String)
Dim currentfilename As String, newfilename As String
Dim i As Integer
Unload frmFileGet
frmReplaceData.Show vbModeless
DoEvents
currentfilename = ActiveWorkbook.Name
Workbooks.Open fn
newfilename = ActiveWorkbook.Name
Windows(currentfilename).Activate
For i = 2 To Worksheets.Count - 2
With Workbooks(currentfilename).Worksheets(i)
.Range("c9:d38").Value =
Workbooks(newfilename).Worksheets(i).Range("c9:d38 ").Value
.Range("f9:g38").Value =
Workbooks(newfilename).Worksheets(i).Range("f9:g38 ").Value
.Range("j9:v38").Value =
Workbooks(newfilename).Worksheets(i).Range("j9:v38 ").Value
.Range("x9:y38").Value =
Workbooks(newfilename).Worksheets(i).Range("x9:y38 ").Value
.Range("aa9:aa38").Value =
Workbooks(newfilename).Worksheets(i).Range("aa9:aa 38").Value
End With
Next i
Workbooks(newfilename).Close SaveChanges:=False
Unload frmReplaceData
End Sub
============================================
regards,
--
Les Hay, Livingston. Scotland







Les[_4_]

Is there a better method to achieve this?
 
Hi James

Further to last post, I altered my own existing code to use your
inner loop method of an array of ranges and by timing the
complete data transfer section found it was reduced from 9.23 secs
to 2.3 secs.

So thanks once again, I feel tour contribution was valuable and I
continue to learn by the help I receive in this newsgroup.

--
Les Hay, Livingston. Scotland
"Les" wrote in message
...
Hi James

Thanks for response

Unfortunately, I can't manage to make your suggested code work.

It
seems like it should, and breaking at various points and

examining
variables, I am surprised to end up with only an empty target
workbook.

Although all the variables show correct data, I just end up with
blank ranges in the target workbook - plus, I can't figure out

why
either.

Sorry for not being able to make it work, as your code fits
precisely with what I had hoped for - a more logical and concise
way of doing it.

regards,
--
Les Hay, Livingston. Scotland
"Jim Becker" wrote in message
...
Here's an alternative, untested:

Sub TransferFileData(fn As String)
Dim Source As Workbook, Target As Workbook
Dim i As Integer, tmpRange As Variant '(String)

Unload frmFileGet
frmReplaceData.Show vbModeless

DoEvents

Set Target = ActiveWorkbook

Set Source = Workbooks.Open(FileName:=fn)

For i = 2 To Worksheets.Count - 2
For Each tmpRange In Array("C9:D38", "F9:G38", _
"J9:V38", "X9:Y38", "AA9:AA38")
Target.Worksheets(i).Range(tmpRange) = _
Source.Worksheets(i).Range(tmpRange)
Next tmpRange
Next i

Source.Close SaveChanges:=False

Unload frmReplaceData
End Sub

--
Hope this helps,
James dot Becker at NCR dot com
~
~
~
:wq!

"Les" wrote in message
...
Hi

I have created a sub routine in my workbook with the

intention
of
allowing the replacing of current data from a similar

workbook
(same structure).

Although this sub does work, and as far as I can tell so

far,
without any problem, I feel it is perhaps a little

cumbersome.

I have searched through the help files to try to find some

sort of
statements better equipped to achieve this but can't find
anything.

Is there a more efficient method to do this? Is it best to

open
the source workbook and copy?

============================================
Sub TransferFileData(fn As String)
Dim currentfilename As String, newfilename As String
Dim i As Integer
Unload frmFileGet
frmReplaceData.Show vbModeless
DoEvents
currentfilename = ActiveWorkbook.Name
Workbooks.Open fn
newfilename = ActiveWorkbook.Name
Windows(currentfilename).Activate
For i = 2 To Worksheets.Count - 2
With Workbooks(currentfilename).Worksheets(i)
.Range("c9:d38").Value =
Workbooks(newfilename).Worksheets(i).Range("c9:d38 ").Value
.Range("f9:g38").Value =
Workbooks(newfilename).Worksheets(i).Range("f9:g38 ").Value
.Range("j9:v38").Value =
Workbooks(newfilename).Worksheets(i).Range("j9:v38 ").Value
.Range("x9:y38").Value =
Workbooks(newfilename).Worksheets(i).Range("x9:y38 ").Value
.Range("aa9:aa38").Value =
Workbooks(newfilename).Worksheets(i).Range("aa9:aa 38").Value
End With
Next i
Workbooks(newfilename).Close SaveChanges:=False
Unload frmReplaceData
End Sub
============================================
regards,
--
Les Hay, Livingston. Scotland










All times are GMT +1. The time now is 03:32 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com