Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35
Default Subroutine works but can it be improved?

I hope that the function of this routine is self expanatory. I am hacking as
best as I can but would like some insight on how this routine could be
improved.

Thanks in advance, Dean.

CopySheetValues(pFromFile As String, pFileStatus As String, pFromSheet As
String, pFromRange As String, pToSheet As String, pTextColumns As Long
'-----------------------------------------------------------------------------------'
' This routine will copy values in a named ranged from a spreadsheet tab
specified '
' in the parameters to a spreadsheet tab after clearing out the existing
data and '
' formatting the first n columns as text in ensure proper database
functions.
'-----------------------------------------------------------------------------------'
Dim i As Long
Dim basebook As Workbook
Dim basesheet As Worksheet
Dim baserangeold As Range
Dim baserangenew As Range
Dim frombook As Workbook
Dim fromsheet As Worksheet
Dim fromrange As Range

Application.DisplayAlerts = False

With Application.FileSearch
.NewSearch
.LookIn = ASFilePath
.SearchSubFolders = False
.Filename = pFromFile
.FileType = msoFileTypeExcelWorkbooks
If .Execute() = 0 Then
Beep
MsgBox "Workbook " & pFromFile & " Not Found. Data Not Copied."
ElseIf .Execute() = 1 Then
If WorkbookOpen(pFromFile) Then
Set frombook = Workbooks(pFromFile)
Else
Set frombook = Workbooks.Open(.FoundFiles(1))
End If
Set basebook = ThisWorkbook
Set basesheet = basebook.Worksheets(pToSheet)
Set fromrange =
frombook.Worksheets(pFromSheet).Range(pFromRange)
Set baserangeold = basebook.Worksheets(pToSheet).UsedRange

With fromrange
Set baserangenew =
basebook.Worksheets(pToSheet).Cells(1, 1).Resize(.Rows.Count, .Columns.Count)
End With

baserangeold.ClearContents
basesheet.Activate

If pTextColumns < 0 Then
For i = 1 To pTextColumns
Columns(i).NumberFormat = "@"
Next i
End If

baserangenew.Value = fromrange.Value

If pFileStatus = "Close" Then
frombook.Close
End If
Else
Beep
MsgBox "Multiple Workbooks Found. Data Not Copied."
End If
End With

Set basebook = Nothing
Set basesheet = Nothing
Set baserangeold = Nothing
Set baserangenew = Nothing
Set frombook = Nothing
Set fromsheet = Nothing
Set fromrange = Nothing

Application.DisplayAlerts = True

End Sub
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Call a subroutine using variable subroutine name dhstein Excel Discussion (Misc queries) 3 July 26th 09 08:28 PM
Need Improved String Formula Tiziano Excel Worksheet Functions 9 April 29th 09 02:54 AM
improved chart in Excel Dion Charts and Charting in Excel 3 June 12th 08 05:40 PM
Improved printing of VBA code? Revolvr[_2_] Excel Programming 0 September 2nd 03 05:22 PM
Improved printing of VBA code? steve Excel Programming 0 August 29th 03 08:42 PM


All times are GMT +1. The time now is 08:50 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"