MACRO HELP! Save out worksheet to a new workbook and value out everything except for specific cell ranges

F

fisht

New Member
Joined
Sep 1, 2013
Messages
47
Hi All,

I am in desperate need of a macro that can save out a particular worksheet from the current workbook to a new workbook. In addition to saving out this worksheet to its own new workbook, I would like the macro to also value out (remove formulas from) everything except for a specific cell range and columns with specific headers.

Details are below:

From old workbook..
Worksheet name: P&L

New workbook..
Worksheet name- same as above (P&L)
Cell range to NOT value out- E11:E13
10 Columns to NOT value out based on headers in row 24 of worksheet- Placed Revenue, Gross Revenue, Net Revenue, Return COGS, COGS, Returns, Total COGS, Gross Profit, MMU%, GM%.
*The reason I would like these column headers to be referenced is because the positioning of these headers change to different columns.

New worksheet's file path (generic)- C:\My Documents\Financials

Having such a macro would be a HUGE help and time savings for me and I would be so grateful. Please let me know if I can assist by answering any questions. I will be continually viewing this post and will be quick to respond.

Thank you!
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Sort by date Sort by votes
Hi fisht,
Try something like this out and see if I got everything you mentioned. (It seems to be working fine for me in testing.)
Note that you never mentioned what you wanted to name the new workbook, so I have it being named "P_and_L Copy" followed by the current date being formatted as month-day-year. This will cause a file saving error if you want to do it more than once a day, so you may need to come up with a different name.
Code: 
Sub MakeCopyAndSaveAsValues()
Dim LstCol As Long, LstRw As Long
Dim MyPath As String, MyNewName As String
MyPath = "C:" & Application.PathSeparator & "My Documents" & Application.PathSeparator & "Financials" & Application.PathSeparator
MyNewName = "P_and_L Copy " & Format(Date, "m-d-yy")

LstCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Sheets("P&L").Copy
With ActiveWorkbook.Sheets("P&L")
  For Col = 1 To LstCol
    LstRw = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Select Case .Cells(24, Col).Value
      Case "Placed Revenue", "Gross Revenue", "Net Revenue", "Return COGS", _
           "COGS", "Returns", "Total COGS", "Gross Profit", "MMU%", "GM%"
        GoTo SkipThisColumn
    End Select
    If Col = 5 Then
      .Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
      .Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
    Else
      .Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
    End If
SkipThisColumn:
  Next Col
End With

ActiveWorkbook.SaveAs MyPath & MyNewName

End Sub

Hope it helps.
 
Upvote 0
Thank you for this HalfAce. My apologies for the delayed response, I will try your code out today and get back to you!

HalfAce said:
Hi fisht,
Try something like this out and see if I got everything you mentioned. (It seems to be working fine for me in testing.)
Note that you never mentioned what you wanted to name the new workbook, so I have it being named "P_and_L Copy" followed by the current date being formatted as month-day-year. This will cause a file saving error if you want to do it more than once a day, so you may need to come up with a different name.
Code: 
Sub MakeCopyAndSaveAsValues()
Dim LstCol As Long, LstRw As Long
Dim MyPath As String, MyNewName As String
MyPath = "C:" & Application.PathSeparator & "My Documents" & Application.PathSeparator & "Financials" & Application.PathSeparator
MyNewName = "P_and_L Copy " & Format(Date, "m-d-yy")

LstCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Sheets("P&L").Copy
With ActiveWorkbook.Sheets("P&L")
  For Col = 1 To LstCol
    LstRw = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Select Case .Cells(24, Col).Value
      Case "Placed Revenue", "Gross Revenue", "Net Revenue", "Return COGS", _
           "COGS", "Returns", "Total COGS", "Gross Profit", "MMU%", "GM%"
        GoTo SkipThisColumn
    End Select
    If Col = 5 Then
      .Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
      .Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
    Else
      .Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
    End If
SkipThisColumn:
  Next Col
End With

ActiveWorkbook.SaveAs MyPath & MyNewName

End Sub

Hope it helps.
Click to expand...
 
Upvote 0
Finally tested the macro you created and it did exactly what I requested. Thank you for this! However, could I trouble you to please add these two items to the existing code:

1) Not to value out cell 'H6' (the same way you did the cell range E11:E13) -- when saving out the new "P_and_L Copy" worksheet

2) Also when saving out the new "P_and_L Copy" worksheet, to carry over three tabs from the old workbook into the new workbook. I do not need these three tabs to be valued out. The three tabs are labeled: "Data", "MTD", and "YTD"

Please let me know if these additions are okay and thanks again.


HalfAce said:
Yeah, what's up with that???

( :LOL: )
Click to expand...
 
Upvote 0
You're most welcome, and it's no trouble at all.
Try replacing these parts of the code with these updates.
Replace this:
Code: 
Sheets("P&L").Copy
with this:
Code: 
Sheets(Array("P&L", "Data", "MTD", "YTD")).Copy

and then replace this:
Code: 
    If Col = 5 Then
      .Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
      .Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
    Else
      .Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
    End If
with this:
Code: 
    If Col = 5 Then
      .Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
      .Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
    ElseIf Col = 8 Then
      .Range(Cells(1, Col), Cells(5, Col)).Value = Range(Cells(1, Col), Cells(5, Col)).Value
      .Range(Cells(7, Col), Cells(LstRw, Col)).Value = Range(Cells(7, Col), Cells(LstRw, Col)).Value
    Else
      .Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
    End If

Hope it helps.
 
Upvote 0
It works so smoothly, thank you so much HalfAce! There's another cell that I would like to remove the valuing-out from, but I'm going to take a stab at it based on the new code you just provided.
 
Upvote 0
You're quite welcome.
Glad to see you want to take a stab at it yourself. Let us know how it works out for you.
 
Upvote 0
Hi HalfAce,

I did (somewhat successfully) add to your code and I have included the 'final code' below. Here are the two additions I made to the original code:

1) Adjusted the naming convention of the new file when it's being saved out:
"Set sh = ActiveWorkbook.Sheets("P&L")" & "MyNewName = sh.Range("E6") & "_" & Format(Date, "yyyy mm dd")"

2) Added another cell range that I did not want to be 'valued' out:
"ElseIf Col = 3 Then .Range(Cells(1, Col), Cells(12, Col)).Value = Range(Cells(1, Col), Cells(12, Col)).Value
.Range(Cells(17, Col), Cells(LstRw, Col)).Value = Range(Cells(17, Col), Cells(LstRw, Col)).Value"

However, there are two new items I need your help with adjusting the code in order to finalize the code:

1) When I run the below code, the correct cell ranges/columns indicated in the code are not valued however the code stops 'valuing' out everything else in the new "P&L" worksheet starting in column 'Q' and onwards.

2) The second adjustment I am looking to have included in the code would be to not value out cells starting with column 'BM' and onwards.

To clarify the above requests, the new code should value out everything (excluding the cell ranges/columns with specific column headers indicated in the current code) in between columns 'A' through 'BL'. Everything in columns 'BM' and onwards should not be valued out.

Please let me know if you have any questions or need me to provide you with more information, and thank you HalfAce!!

Final Code:

Sub MakeCopyAndSaveAsValues()
Dim LstCol As Long, LstRw As Long
Dim MyPath As String, MyNewName As String
Set sh = ActiveWorkbook.Sheets("P&L")
MyPath = "C:" & Application.PathSeparator & "My Documents" & Application.PathSeparator & "Financials" & Application.PathSeparator
MyNewName = sh.Range("E6") & "_" & Format(Date, "yyyy mm dd")


LstCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Sheets(Array("P&L", "Data", "MTD", "YTD")).Copy
With ActiveWorkbook.Sheets("P&L")
For Col = 1 To LstCol
LstRw = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Select Case .Cells(24, Col).Value
Case "Placed Revenue", "Gross Revenue", "Net Revenue", "Return COGS", _
"COGS", "Returns", "Total COGS", "Gross Profit", "MMU%", "GM%"
GoTo SkipThisColumn
End Select
If Col = 5 Then
.Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
.Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
ElseIf Col = 8 Then
.Range(Cells(1, Col), Cells(5, Col)).Value = Range(Cells(1, Col), Cells(5, Col)).Value
.Range(Cells(7, Col), Cells(LstRw, Col)).Value = Range(Cells(7, Col), Cells(LstRw, Col)).Value
ElseIf Col = 3 Then
.Range(Cells(1, Col), Cells(12, Col)).Value = Range(Cells(1, Col), Cells(12, Col)).Value
.Range(Cells(17, Col), Cells(LstRw, Col)).Value = Range(Cells(17, Col), Cells(LstRw, Col)).Value

Else
.Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
End If
SkipThisColumn:
Next Col
End With


ActiveWorkbook.SaveAs MyPath & MyNewName


End Sub
 
Upvote 0
After some more probing/testing, I thought it might be helpful to share some more information:

If I activate the below code within the 'P&L' worksheet (Alt + F8), the code does exactly as its supposed to. However, I have inserted a button on the first worksheet in the workbook and assigned the below macro to it, and when I click the button to run the macro the outcome is what I have listed in my prior post... I thought it was interesting that the result is different. I am looking to have the macro run via a button on the first worksheet of the workbook.

HalfAce, if you could examine and solve for this at your earliest convenience that would help me out a lot. I appreciate all your effort in solving for these scenarios I have presented to you.

Thank you!


fisht said:
Hi HalfAce,

I did (somewhat successfully) add to your code and I have included the 'final code' below. Here are the two additions I made to the original code:

1) Adjusted the naming convention of the new file when it's being saved out:
"Set sh = ActiveWorkbook.Sheets("P&L")" & "MyNewName = sh.Range("E6") & "_" & Format(Date, "yyyy mm dd")"

2) Added another cell range that I did not want to be 'valued' out:
"ElseIf Col = 3 Then .Range(Cells(1, Col), Cells(12, Col)).Value = Range(Cells(1, Col), Cells(12, Col)).Value
.Range(Cells(17, Col), Cells(LstRw, Col)).Value = Range(Cells(17, Col), Cells(LstRw, Col)).Value"

However, there are two new items I need your help with adjusting the code in order to finalize the code:

1) When I run the below code, the correct cell ranges/columns indicated in the code are not valued however the code stops 'valuing' out everything else in the new "P&L" worksheet starting in column 'Q' and onwards.

2) The second adjustment I am looking to have included in the code would be to not value out cells starting with column 'BM' and onwards.

To clarify the above requests, the new code should value out everything (excluding the cell ranges/columns with specific column headers indicated in the current code) in between columns 'A' through 'BL'. Everything in columns 'BM' and onwards should not be valued out.

Please let me know if you have any questions or need me to provide you with more information, and thank you HalfAce!!

Final Code:

Sub MakeCopyAndSaveAsValues()
Dim LstCol As Long, LstRw As Long
Dim MyPath As String, MyNewName As String
Set sh = ActiveWorkbook.Sheets("P&L")
MyPath = "C:" & Application.PathSeparator & "My Documents" & Application.PathSeparator & "Financials" & Application.PathSeparator
MyNewName = sh.Range("E6") & "_" & Format(Date, "yyyy mm dd")


LstCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Sheets(Array("P&L", "Data", "MTD", "YTD")).Copy
With ActiveWorkbook.Sheets("P&L")
For Col = 1 To LstCol
LstRw = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Select Case .Cells(24, Col).Value
Case "Placed Revenue", "Gross Revenue", "Net Revenue", "Return COGS", _
"COGS", "Returns", "Total COGS", "Gross Profit", "MMU%", "GM%"
GoTo SkipThisColumn
End Select
If Col = 5 Then
.Range(Cells(1, Col), Cells(10, Col)).Value = Range(Cells(1, Col), Cells(10, Col)).Value
.Range(Cells(14, Col), Cells(LstRw, Col)).Value = Range(Cells(14, Col), Cells(LstRw, Col)).Value
ElseIf Col = 8 Then
.Range(Cells(1, Col), Cells(5, Col)).Value = Range(Cells(1, Col), Cells(5, Col)).Value
.Range(Cells(7, Col), Cells(LstRw, Col)).Value = Range(Cells(7, Col), Cells(LstRw, Col)).Value
ElseIf Col = 3 Then
.Range(Cells(1, Col), Cells(12, Col)).Value = Range(Cells(1, Col), Cells(12, Col)).Value
.Range(Cells(17, Col), Cells(LstRw, Col)).Value = Range(Cells(17, Col), Cells(LstRw, Col)).Value

Else
.Range(Cells(1, Col), Cells(LstRw, Col)).Value = Range(Cells(1, Col), Cells(LstRw, Col)).Value
End If
SkipThisColumn:
Next Col
End With


ActiveWorkbook.SaveAs MyPath & MyNewName


End Sub
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
VBA Macros running slow out of nowhere
Replies
3
Views
211
mumps
mumps
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
228
Insurance Dave
I
G
  • Question
Macro to consolidate multiple worksheets into Master based on cell data?
Replies
1
Views
272
bobaol
B
T
  • Solved
Copy worksheet to new workbook without formulas or macro button
Replies
9
Views
552
Tgrundy09
T
S
  • Solved
For each row, create new folder based on single cell value, then save exported XML doc to matching folder.
Replies
3
Views
171
shand
S

Forum statistics

Threads
1,214,965
Messages
6,122,496
Members
449,089
Latest member
Raviguru

Share this page

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