Updates are still taking place. Sorry for delays!
There's no such thing as a stupid question, but they're the easiest to answer.
JoinTour
Login
 
Tag Cloud
audio avg avg 8 blue screen brand new codec control panel conversion crash delete personal data desktop display dos driver duplicate dvd error error message excel explorer file firefox game graphics hardware hijackthis log install installation internet itunes javascript laptop macro malware monitor msconfig msn music network outlook outlook 2003 outlook express php problem program random rundll32 security seo sound sp3 spyware switch tag cloud trojan usb video virtumonde virus vista visual basic vundo wallpaper windows windows vista windows xp wireless word xp sp3 youtube
Software Development
Search
Search in:
 
Advanced Search
Tech Support Guy Forums > Software & Hardware > Software Development >
macro using in different workbooks


HELLO AND WELCOME! Before you can post your question, you'll have to register -- it's completely free! Click here to join today! We highly recommend that you print a copy of our Guide for New Members. Enjoy!

 
Thread Tools
Uwatcher's Avatar
Computer Specs
Junior Member with 6 posts.
 
Join Date: Apr 2008
Experience: Intermediate
23-Apr-2008, 05:12 AM #1
macro using in different workbooks
I have recorded a macro to autofil another xcel workbook this works fine and opens the workbook and completes all the fields. My problem is I want to use the same macro in workbooks with different names?? ie in the code it refers to the workbook "blankquote" and I want it to run from any workbook that I save from the original "blankquote"
Is there a code I can use ie "current workbook" ???
Here's hoping someone can help?

Last edited by Uwatcher : 23-Apr-2008 12:14 PM.
Jimmy the Hand's Avatar
Senior Member with 762 posts.
 
Join Date: Jul 2006
Location: Hungary
Experience: With Excel, fairly good. With the rest, mediocre.
24-Apr-2008, 02:43 AM #2
The expression you are looking for is ActiveWorkbook.

Things might not be that easy, however, since Excel's macro recorder is known to create disposable code, from time to time, using absolute references when relative ones would be better, and relative references when absolute ones would be better.
You may want to post the whole code, or your workbook, for revision.

Jimmy
__________________
_______________________
It is advised to provide a clear, detailed description of the task, so that others can understand it, and offer the best possible help. Otherwise, you risk experts ignoring your request.
Uwatcher's Avatar
Computer Specs
Junior Member with 6 posts.
 
Join Date: Apr 2008
Experience: Intermediate
24-Apr-2008, 11:52 AM #3
JIMMY YOU SOUND LIKE THE MAN HERE IS THE MODULE I AM USING. THE MAIN WORKBOOK IS BLANKELECQUOTE Which I normally open, complete save as "quote name" then fill in the batch header named "0304 Version G .xls"

'
' batch1yr Macro
' Macro recorded 18/04/2008 by lance
'

'
Workbooks.Open Filename:= _
"Z:\Energy\Electricity\Suppliers\Scottish Power\0304 Version G .xls"
Windows.CompareSideBySideWith "BLANKELECQUOTE"
Windows.SyncScrollingSideBySide = False
Windows("BLANKELECQUOTE.xls").Activate
Sheets("electricity and one year").Select
ActiveWindow.SmallScroll Down:=-18
Range("A6").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("I33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("A7").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-3
Range("G2").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("L33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("F1").Select
Application.CutCopyMode = False
Selection.ClearContents
Windows("0304 Version G .xls").Activate
Selection.ClearContents
Windows("BLANKELECQUOTE.xls").Activate
Range("G2").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("M33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L33").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Utility Switch"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "Arial Narrow"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L34").Select
Windows("BLANKELECQUOTE.xls").Activate
ActiveWindow.SmallScroll Down:=45
Range("F47").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("O33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("G48").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("F48").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("P33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("G49").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("F49").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("Q33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("G50").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-42
Range("C4").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("R33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("S33").Select
ActiveWindow.SmallScroll Down:=6
Windows("BLANKELECQUOTE.xls").Activate
Range("F8").Select
ActiveWindow.SmallScroll Down:=39
Range("C48").Select
Application.CutCopyMode = False
Selection.Copy
Windows("0304 Version G .xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("D49").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C49").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("T33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("D50").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C50").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("U33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
Windows("BLANKELECQUOTE.xls").Activate
ActiveWindow.SmallScroll Down:=3
Range("C53").Select
Application.CutCopyMode = False
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("W33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("G50").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("F50").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("X33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("D52").Select
Sheets("Proposal sheet").Select
Range("G5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("Z33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("I6").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("H5").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("AA33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("K5").Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("electricity and one year").Select
ActiveWindow.SmallScroll Down:=-18
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.SmallScroll Down:=-15
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.SmallScroll Down:=-3
Range("AD17").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-R[6]C[-5]"
Range("AD17").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("AB33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("AD19").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
Range("J19").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("AC33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=4
Windows("BLANKELECQUOTE.xls").Activate
ActiveWindow.SmallScroll Down:=9
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=12
Range("F41").Select
Application.CutCopyMode = False
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("AD33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=7
Windows("BLANKELECQUOTE.xls").Activate
Range("H37").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C41").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("AE33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("H38:H39").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D41").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("AF33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BLANKELECQUOTE.xls").Activate
Range("H35:H36").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("E41").Select
Selection.Copy
Windows("0304 Version G .xls").Activate
Range("AG33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AJ33").Select
ActiveWindow.SmallScroll ToRight:=-13
Range("O33:Y33").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 40
ActiveWindow.SmallScroll ToRight:=-26
Range("V38").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("O33:W33").Select
Selection.Copy
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
Range("AS33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=17
End Sub
OBP's Avatar
OBP OBP is offline
Computer Specs
Distinguished Member with 5,244 posts.
 
Join Date: Mar 2005
Location: UK
Experience: An old Basic Programmer
24-Apr-2008, 02:55 PM #4
Jimmy, it is great to see you back on here.
This Macro looks like a "Recorded Macro" rather than VBA, a lot of Selections and Activates and Scrolling etc.
I am sure you can make it far more compact and efficient, if you don't have time let Bomb or Firefytr know about it, or I might get time from my Access programming to have a go myself.
__________________
.
.
OBP
I do not give up easily
Jimmy the Hand's Avatar
Senior Member with 762 posts.
 
Join Date: Jul 2006
Location: Hungary
Experience: With Excel, fairly good. With the rest, mediocre.
25-Apr-2008, 02:16 AM #5
Thanks, OBP
I have 2 days before going on holiday, but I'm sure it will be enough to make the code more efficient.

Uwatcher,
I'll work on the macro then come back with the revised version.
In the meantime, let me tell what got through, because I might have got it wrong.

So you have the "BLANKELECQUOTE.xls" file which is, actually, a template for quotes.
Task 1. You complete the template with relevant data, then save the workbook on a new name, a name that probably refers to the new quote.
Task 2. When the template is complete, you also want to copy some data from the completed template (i.e. the new quote) to the batch header named "0304 Version G .xls" You also want to be able to do this anytime later, using the saved quote workbook.
The objective of the macro is to get Task 2. done.

I propose to implement an interactive file selection in the code, so that the user can browse and select the quote workbook they want to get processed. I'll go down this path unless you tell me I'm wrong. Please give me feedback ASAP, because I don't want to work too much in vain.

Jimmy
__________________
_______________________
It is advised to provide a clear, detailed description of the task, so that others can understand it, and offer the best possible help. Otherwise, you risk experts ignoring your request.
Jimmy the Hand's Avatar
Senior Member with 762 posts.
 
Join Date: Jul 2006
Location: Hungary
Experience: With Excel, fairly good. With the rest, mediocre.
25-Apr-2008, 05:41 AM #6
Well, it's too late now, I finished the 1st round with this macro.

Here's the code. I think it does the same as the original. Please test it and give feedback.
Please make a backup of the original files before testing this macro.

Code:
Sub Revised_Code()
    Const BH = "Z:\Energy\Electricity\Suppliers\Scottish Power\0304 Version G .xls"
    Dim Quote As Workbook, BHeader As Workbook
    Dim Source As Worksheet, Target As Worksheet
    Dim FN As String
    
    FN = Application.GetOpenFilename(, , , , False)
    If FileName = "False" Then Exit Sub
    Set Quote = Workbooks.Open(FileName:=FN)
    Set BHeader = Workbooks.Open(FileName:=BH)

    Set Source = Quote.Sheets("electricity and one year")
    Set Target = BHeader.Sheets(1)      'Note that the targeted sheet in 0304 Version G .xls
                                        'has never been specified in the code
                                        'So I assumed it to be the 1st worksheet in the workbook
                                     
    Source.Range("A6").Copy
    Target.Range("I33").PasteSpecial xlPasteValues
    Source.Range("G2").Copy
    Target.Range("M33").PasteSpecial xlPasteValues
    
    Source.Range("L33") = "Utility Switch"
    With Source.Range("L33").Font
        .Name = "Arial Narrow"
        .FontStyle = "Regular"
        .Size = 10
        'Some formatting options here were left out. I think they did nothing, actually.
    End With
    
    Source.Range("F47:F49").Copy
    Target.Range("O33").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Source.Range("C4").Copy
    Target.Range("R33").PasteSpecial xlPasteValues
    Source.Range("C48:C50").Copy
    Target.Range("S33").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Source.Range("C53").Copy
    Target.Range("W33").PasteSpecial xlPasteValues
    Source.Range("F50").Copy
    Target.Range("X33").PasteSpecial xlPasteValues
    
    Source.Range("AD17").FormulaR1C1 = "=RC[-1]-R[6]C[-5]"
    Source.Range("AD17").Copy
    Target.Range("AB33").PasteSpecial xlPasteValues
    Source.Range("J19").Copy
    Target.Range("AC33").PasteSpecial xlPasteValues
    Source.Range("F41").Copy
    Target.Range("AD33").PasteSpecial xlPasteValues
    Source.Range("C41:E41").Copy
    Target.Range("AE33").PasteSpecial xlPasteValues

    Source.Range("A7, F1, G48, G49, G50, D49, D50, G50, A19, H35:H39").ClearContents

    Set Source = Quote.Sheets("Proposal sheet")
    Source.Range("G5:H5").Copy
    Target.Range("Z33").PasteSpecial xlPasteValues


    Source.Range("I6, K5").ClearContents
    Target.Range("V38").ClearContents
    Target.Range("O33:W33").Copy
    Target.Range("AS33").PasteSpecial xlPasteValues
End Sub
Uwatcher's Avatar
Computer Specs
Junior Member with 6 posts.
 
Join Date: Apr 2008
Experience: Intermediate
29-Apr-2008, 12:26 PM #7
jimmy sorry been up against it am trying the macro tomorrow hope you enjoy the break will update thread as soon as I've tried it. many thanks
Uwatcher's Avatar
Computer Specs
Junior Member with 6 posts.
 
Join Date: Apr 2008
Experience: Intermediate
08-May-2008, 03:55 AM #8
macro still frying my head
Jimmy if you're out there thanks for the code however it stalls at the first command I think this may be because I am running the macro from the file I have open? I think it may be easier to import the batch header sheet ("0304 Version G .xls") into the blank quote thereby negating the need for a macro that will operate in all workbooks. What do you think I would rather not do this but I don't want to take up to much of your time?
Jimmy the Hand's Avatar
Senior Member with 762 posts.
 
Join Date: Jul 2006
Location: Hungary
Experience: With Excel, fairly good. With the rest, mediocre.
08-May-2008, 04:49 AM #9
Don't worry, I won't let you take up more of my time than I wish

I'm not sure what the problem is. I don't even know, what you mean by "the first command". I see one immediate error in the code.
Code:
If FileName = "False" Then Exit Sub
is wrong,
Code:
If FN = "False" Then Exit Sub
should be used. But I don't think that's it.

It is always complicated to modify a code without knowing the exact data structure. I could fix the code in no time if only I had the batch header sheet ("0304 Version G .xls") and one quote to work with. Can you upload them? Or send them to me in email? This latter seems better, if you don't trust the world with sensitive data, but do trust me. Or you can replace any sensitive data with dummies.

Or we can try to continue with me blindfolded... won't be very effective I fear.

Jimmy
__________________
_______________________
It is advised to provide a clear, detailed description of the task, so that others can understand it, and offer the best possible help. Otherwise, you risk experts ignoring your request.
Uwatcher's Avatar
Computer Specs
Junior Member with 6 posts.
 
Join Date: Apr 2008
Experience: Intermediate
08-May-2008, 05:36 AM #10
macro
Jimmy I'll happily send you the quote and batch header my works email is as past I'm currently at my desk as soon as I receive your details I'll forward them on. Many thanks.

Last edited by Uwatcher : 08-May-2008 06:19 AM.
Zack Barresse's Avatar
Computer Specs
Distinguished Member with 3,211 posts.
 
Join Date: Jul 2004
Location: Oregon, United States
Experience: I'ma learnin'!
08-May-2008, 02:59 PM #11
I would use a couple other routines/functions as well, just to speed/optimizie code. You could also shorten it w/o using the Copy method. See if this works (NB: I did not test this except compiling)...
Code:
Sub Revised_Code()
    Const BH As String = "Z:\Energy\Electricity\Suppliers\Scottish Power\0304 Version G .xls"
    Const BHname As String = "0304 Version G .xls"
    Dim wbQuote As Workbook, wbBHeader As Workbook
    Dim wsSource As Worksheet, wsTarget As Worksheet, wsProposal As Worksheet
    Dim sFullFile As String, sNameFile As String
    Dim bFNopen As Boolean, bBHopen As Boolean
    Call TOGGLEEVENTS(False)
    sFullFile = Application.GetOpenFilename(, , , , False)
    If TypeName(sFullFile) = "Boolean" Then Exit Sub
    sNameFile = Right(sFullFile, Len(sFullFile) - InStrRev(sFullFile, Application.PathSeparator))
    If ISWBOPEN(sNameFile) = True Then
        bFNopen = True
        Set wbQuote = Workbooks(sNameFile)
    Else
        bFNopen = False
        Set wbQuote = Workbooks.Open(Filename:=sFullFile)
    End If
    If ISWBOPEN(BHname) = True Then
        bBHopen = True
        Set wbBHeader = Workbooks(BHname)
    Else
        bBHopen = False
        Set wbBHeader = Workbooks.Open(Filename:=BH)
    End If
    Set wsSource = wbQuote.Sheets("electricity and one year")
    Set wsTarget = wbBHeader.Sheets(1) 'first sheet???
    wsTarget.Range("I33").Value = wsSource.Range("A6").Value
    wsTarget.Range("M33").Value = wsSource.Range("G2").Value
    wsSource.Range("L33").Value = "Utility Switch"
    wsSource.Range("L33").Font.Name = "Arial Narrow"
    wsSource.Range("L33").Font.Size = 10
    wsTarget.Range("O33:Q33").Value = Application.Transpose(wsSource.Range("F47:F49").Value)
    wsTarget.Range("R33").Value = wsSource.Range("C4").Value
    wsTarget.Range("S33:U33").Value = Application.Transpose(wsSource.Range("C48:C50").Value)
    wsTarget.Range("W33").Value = wsSource.Range("C53").Value
    wsTarget.Range("X33").Value = wsSource.Range("F50").Value
    wsSource.Range("AD17").FormulaR1C1 = "=RC[-1]-R[6]C[-5]"
    wsTarget.Range("AB33").Value = wsSource.Range("AD17").Value
    wsTarget.Range("AC33").Value = wsSource.Range("J19").Value
    wsTarget.Range("AD33").Value = wsSource.Range("F41").Value
    wsTarget.Range("AE33:AG33").Value = wsSource.Range("C41:E41").Value
    wsSource.Range("A7,F1,G48,G49,G50,D49,D50,G50,A19,H35:H39").ClearContents
    Set wsProposal = wbQuote.Sheets("Proposal sheet")
    wsTarget.Range("Z33:AB33").Value = wsProposal.Range("G5:H5").Value
    wsProposal.Range("I6,K5").ClearContents
    wsTarget.Range("V38").ClearContents
    wsTarget.Range("AS33:BA33").Value = wsTarget.Range("O33:W33").Value
    If bFNopen = False Then wbQuote.Close savechanges:=False 'fasle or true??
    If bBHopen = False Then wbBHeader.Close savechanges:=False 'fasle or true??
    Call TOGGLEEVENTS(True)
End Sub

Public Sub TOGGLEEVENTS(ByVal blnState As Boolean)
'Originally written by Zack Barresse
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub

Public Function ISWBOPEN(wbName As String) As Boolean
'Originally found by Jake Marx
    On Error Resume Next
    ISWBOPEN = Len(Workbooks(wbName).Name)
End Function
HTH
Jimmy the Hand's Avatar
Senior Member with 762 posts.
 
Join Date: Jul 2006
Location: Hungary
Experience: With Excel, fairly good. With the rest, mediocre.
09-May-2008, 03:49 AM #12
Lance,

The attachment is a VBA module. You can (after unzip) import it into BLANKELECQUOTE.xls in VBA editor, via File menu -> Import File command.

In the module you'll find the revised macro, which I named "ProcessQuote".
It contains a few extras, like

- checking if batch header file is open or not (by Zack's recommendation)
- allowing to choose between processing a saved quote or the filled BLANKELECQUOTE
- copying the data into a new row for each processed quote
- the quote workbook will be closed after processing, except if it's BLANKELECQUOTE.xls
Batch header file will not be closed, expecting process of further quotes.

Also by Zack's recommendation, I removed Copy/PasteSpecial methods wherever I could, and replaced them by simple "=" operators.

Check if it works the way you want. Make backups before trying.

Zack,
I experimented with your code, and found two uncertain spots. These parts didn't work for me:
Code:
If TypeName(sFullFile) = "Boolean" Then Exit Sub

Application.Transpose(something)
Any idea why?

Jimmy
Attached Files
File Type: zip ProcessQuote.zip (1.4 KB, 2 views)
__________________
_______________________
It is advised to provide a clear, detailed description of the task, so that others can understand it, and offer the best possible help. Otherwise, you risk experts ignoring your request.
Uwatcher's Avatar
Computer Specs
Junior Member with 6 posts.
 
Join Date: Apr 2008
Experience: Intermediate
09-May-2008, 04:28 AM #13
Jimmy this is absolutely brilliant without a doubt you have made my life so much easier Oh and a round of applause to Zack if there is ever anything I can do for you let me know I broker gas elec and telecoms for a living if you ever need any advice drop us a line and I'll be only to happy to help.
One thing if I need to change the destination file for other batch headers I take it all I need to do is amend the target worksheet and select ranges?
Jimmy the Hand's Avatar
Senior Member with 762 posts.
 
Join Date: Jul 2006
Location: Hungary
Experience: With Excel, fairly good. With the rest, mediocre.
09-May-2008, 05:33 AM #14
Happy to help

Quote:
Originally Posted by Uwatcher View Post
One thing if I need to change the destination file for other batch headers I take it all I need to do is amend the target worksheet and select ranges?
Yes, more or less so. Seting Const BH to the full path of the new batch header file, (or setting the target sheet to a new (inserted) one,) and changing the Target.Range(something) = Source.Range(something else) parts of the code should be enough.
But be aware that there are a couple of other operations in the macro, such as formatting cell font, adding a formula to cell AD17, clearing cell contents in a few cells, etc.
I suggest you make a copy of the macro, keep the original and alter the copy .

Jimmy
__________________
_______________________
It is advised to provide a clear, detailed description of the task, so that others can understand it, and offer the best possible help. Otherwise, you risk experts ignoring your request.
Zack Barresse's Avatar
Computer Specs
Distinguished Member with 3,211 posts.
 
Join Date: Jul 2004
Location: Oregon, United States
Experience: I'ma learnin'!
09-May-2008, 12:31 PM #15
Oh yes, sorry. You must dimension the file with the GetOpenFileName method as a Variant in order to check for a boolean (true/false) name type return, which would be more all-encompassing than just checking for a string...
Code:
Dim sFullFile As Variant
Not sure why you're failing on the Transpose() function. Is there a specific line? They work on tests for me.

Again, I don't have any actual data or files to test this on, so I can only do so much.


Note, if you're going to be performing this operation on other data, I'd recommend putting everything that changes a worksheet/book in a separate sub, then just calling that sub (passing parameters if needed to it for specifics of the routine).

HTH
__________________
___________
Regards, Zack - MVP - MS Excel 2005-2008 (If you would like comments in any code, please say so.)

OfficeArticles.com :|: Extreme Excel Tutorial :|: Excel Articles by Ken Puls :|: Excel User Group, by Nick Hodge

What is a Microsoft MVP? :|: Live Tech Support? Click here
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

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

You Are Using:
Server ID
Advertisements do not imply our endorsement of that product or service.
All times are GMT -4. The time now is 11:05 PM.
Copyright © 1996 - 2008 TechGuy, Inc. All rights reserved.
Powered by vBulletin, Copyright © 2000 - 2008, Jelsoft Enterprises Ltd.
Search Engine Optimization by vBSEO 3.1.0
Powered by Cermak Technologies, Inc.