Write generic code to run from active worksheet

03856me

Active Member
Joined
Apr 4, 2008
Messages
297
I have written code to copy the active worksheet to a new workbook and then perform formatting on the new file, save and close, then return back to the main workbook. This code ran perfectly on the first worksheet I setup, but after copying the worksheet to setup the next location, the code does not run correctly (the wrong sheet is copied and the formatting doesn't happen). My goal is to make the code generic so each time the user adds a new customer (a weekly function), the code does not have to be changed, it will just run.

Is this possible? How would I add a row of code at the beginning of the macro to switch the ActiveSheet focus to the worksheet the button(macro) is being ran from, without having to use the sheet name.

Code:
[FONT=Verdana]Sub Create_uploadFile()[/FONT]
[FONT=Verdana]
'check to see if the Rate ID is a number
    If ActiveSheet.Range("X3").Value = "INPUT HERE" Then
        MsgBox ("POPULATE the Rate ID, try again!!")
        ActiveSheet.Range("X3").Select
        Exit Sub
    End If
'check to see if the Sales Agreement # is populated
    If ActiveSheet.Range("X4").Value = "INPUT HERE" Then
        MsgBox ("POPULATE the Sales Agreement #, try again!!")
        ActiveSheet.Range("X4").Select
        Exit Sub
    End If
'check to see if the Contract # is populated
    If ActiveSheet.Range("X5").Value = "INPUT HERE" Then
        MsgBox ("POPULATE the Contract #, try again!!")
        ActiveSheet.Range("X5").Select
        Exit Sub
    End If[/FONT]
[FONT=Verdana]    Application.ScreenUpdating = False
 
'Copy the active sheet to a new workbook
    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook
    Dim MainWkbk        As Workbook
    Dim TargetWkbk      As Workbook
    
    Set MainWkbk = ActiveWorkbook
 
    FPath = "S:\Matrix uploads\"
    FName = ActiveSheet.Range("X5") & "-" & ActiveSheet.Range("X3") & "-" & Range("X2") & "-" & Range("X4")
 
    Set NewBook = Workbooks.Add
    MainWkbk.Activate
    ActiveSheet.Copy Before:=NewBook.Sheets(1)
 
Application.DisplayAlerts = False[/FONT]
[FONT=Verdana] 
   Set TargetWkbk = ActiveWorkbook
    TargetWkbk.Activate
    ActiveWorkbook.SaveAs Filename:=FPath & FName & ".xlsx", _
       FileFormat:=xlOpenXMLWorkbook[/FONT]
[FONT=Verdana]
'Delete button
Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next shp   
 
'Format exported file
With ActiveSheet.Range("AB2")
    .Value = "EXPORTED FILE"
    .Font.Bold = True
    .Font.Color = vbRed
    .Font.Size = 12
End With[/FONT]
[FONT=Verdana]
Range("C2").Select[/FONT]
[FONT=Verdana]'Delete extra sheet
Sheets("Sheet1").Delete[/FONT]
[FONT=Verdana]
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWorkbook.Close SaveChanges:=True[/FONT]
[FONT=Verdana] 
   MsgBox "Your new file as been setup as " & FName & ".xlsx " & vbCr & _
    vbCr & "          ========== SAVED TO ==========" & vbCr & vbCr & FPath
End Sub[/FONT]
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
If you want the code to run for the active sheet of the workbook the code is in try changing ActiveSheet to ThisWorkbook.ActiveSheet.
Code:
Option Explicit

Sub Create_uploadFile()
'Copy the active sheet to a new workbook
Dim NewBook As Workbook
Dim wsToCopy As Worksheet
Dim shp As Shape
Dim FName As String
Dim FPath As String

    Set wsToCopy = ThisWorkbook.ActiveSheet

    With wsToCopy

        'check to see if the Rate ID is a number
        If .Range("X3").Value = "INPUT HERE" Then
            MsgBox ("POPULATE the Rate ID, try again!!")
            Application.Goto .Range("X3"), True
            Exit Sub
        End If

        'check to see if the Sales Agreement # is populated
        If .Range("X4").Value = "INPUT HERE" Then
            MsgBox ("POPULATE the Sales Agreement #, try again!!")
            Application.Goto .Range("X4"), True
            Exit Sub
        End If

        'check to see if the Contract # is populated
        If .Range("X5").Value = "INPUT HERE" Then
            MsgBox ("POPULATE the Contract #, try again!!")
            Application.Goto .Range("X5"), True
            Exit Sub
        End If

        FPath = "S:\Matrix uploads\"
        FName = .Range("X5").Value & "-" & .Range("X3").Value & "-" & .Range("X2").Value & "-" & .Range("X4").Value

        Application.ScreenUpdating = False
        
        .Copy
        
    End With

    Set NewBook = ActiveWorkbook

    Application.DisplayAlerts = False

    NewBook.SaveAs Filename:=FPath & FName & ".xlsx", _
                   FileFormat:=xlOpenXMLWorkbook

    'Delete button
    With NewBook.ActiveSheet
        For Each shp In .Shapes
            shp.Delete
        Next shp

        'Format exported file
        With .Range("AB2")
            .Value = "EXPORTED FILE"
            .Font.Bold = True
            .Font.Color = vbRed
            .Font.Size = 12
        End With

    End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    NewBook.Close SaveChanges:=True

    MsgBox "Your new file as been setup as " & FName & ".xlsx " & vbCr & _
           vbCr & "          ========== SAVED TO ==========" & vbCr & vbCr & FPath
           
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,237
Messages
6,170,928
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top