Saving a Excel workbook with folder and filename from range of cell contents

[garthkh]

Hi
I found a part of my answer in an old post but I would like extra help please. I'm not an expert at Excel or VBA.
I have a workbook that must be filled in by a number of different people each day, after each of 3 shifts. I have created a button with a VBA macro to save the workbook into a folder and filename supplied by a range of cell contents (A3, B3 C3, D3 and E3 where A3 is t be used as the folder name and the rest as a filename). I can't get the Cell A3 to use the existing folder on the desktop. The whole string gets saved onto the desktop as a filename AND I'm left with a workbook that now has the new filename.

I started the VBA module just to clear all entered cells at the end - hence the Sub still has this name.
I would really like to only save the sheet and not the whole workbook - and be left with just the original workbook template on my screen for the next person on shift to fill out.
I need to eventually have this workbook/worksheet saved into SharePoint in the 365 cloud where the Admins can access it once saved.

Sub ClearValuesOnly()

Dim Path As String
Dim filename As String
Dim folder As String
folder = Range("A3").Value
Path = "C:\Users\garth\Desktop\" & folder

ThisFile = Range("B3").Value & Range("C3").Value & Range("D3").Value & Format(Range("E3").Value, "dd-mm-yyyy")
ActiveWorkbook.SaveAs filename:=Path & ThisFile & ".xls"

Range("A3:D3").ClearContents
Range("B7:B28").ClearContents
Range("B40:B50").ClearContents
End Sub

 

[nemmi69]

Does this work for you? (not tried it myself)

Sub Macro1()
Dim ThisFile As String
Dim Path As String
Dim filename As String
Dim folder As String

folder = Range("A3").Value
Path = "C:\Users\garth\Desktop\" & folder
ThisFile = Range("B3").Value & Range("C3").Value & Range("D3").Value & Format(Range("E3").Value, "dd-mm-yyyy")

ThisWorkbook.ActiveSheet.Copy

ActiveWorkbook.SaveAs filename:=Path & ThisFile & ".xls"
End Sub

 

[nemmi69]

the current folder can be got from CELL("filename",C2) entered in A3

 

[garthkh]

the current folder can be got from CELL("filename",C2) entered in A3

Thanks for your replies. The copy sheet does save the sheet to the desktop but it does leave the original workbook open and now also the new sheet that is created open. Is there a way to close both these down as they are no longer needed? The new shift will start the process again using the blank" workbook template. I don't want the carer on shift to delete them, if possible, as they might try to save the document again (which is now been cleared of data).
I don't understand your 2nd reply and what it does from Cell C2. All I am wanting is for the workbook being saved to use the cell contents of C3 (the House Name) to know which folder to save this worksheet into. There are 4 or 5 houses that will be sending these forms in, and I'm try to make the process of sending the forms off to an Admin more automatic by saving these submissions directly into the appropriate folders (Point Cook House, Blackheath House, etc). The Carer has to fill in A3 - D3 using the dropdown lists for each cell Once I have this working on the desktop I want to finalise it to save into OneDrive's folders in the cloud. I thought I could just use the contents of A3 as per code . Why is folder not working in this way?

Dim folder As String
folder = Range("A3").Value
Path = "C:\Users\garth\Desktop\" & folder

 

[garthkh]

I have managed to resolve most of my VBA code for the Sheet I'm busy with
I need now to add to my code, at the beginning, to :

fill cells B30:34 with "N/A" text if the cell F3 does not contain "Wednesday". Sounds simple but I'm stuck and searching the net for an answer.

My code (a bit long winded probably) that is now working and saving the completed workbook into a OneDrive folder is as follows:

Sub ValidateForm()

Dim Path As String
Dim filename As String
Dim folder As String
Dim ThisFile As String

Dim i As Long
Dim c As Long
Dim myRange As Range
Dim myCell As Range
Dim AutoNA As Range

Set myRange = Range("A3:D3")
Set myRange2 = Range("B7:B28")
Set myRange3 = Range("B30:B38")
Set myRange4 = Range("B40:B47")
Set AutoNA = Range("B30:B34")


For Each myCell In myRange
c = c + 1
If IsEmpty(myCell) Then
i = i + 1
End If
Next myCell

For Each myCell In myRange2
c = c + 1
If IsEmpty(myCell) Then
i = i + 1
End If
Next myCell

For Each myCell In myRange3
c = c + 1
If IsEmpty(myCell) Then
i = i + 1
End If
Next myCell

For Each myCell In myRange4
c = c + 1
If IsEmpty(myCell) Then
i = i + 1
End If
Next myCell


If i > 0 Then
MsgBox _
"Not all cells have been filled in - There are " & i & " empty cell(s)"
Else

folder = Range("A3").Value & "\"
'Path = "C:\Users\garth\Desktop\" & folder
Path = "C:\Users\garth\OneDrive\Documents\" & folder


ThisFile = Range("B3").Value & Range("C3").Value & Range("D3").Value & Format(Range("E3").Value, "dd-mm-yyyy")

ActiveWorkbook.SaveAs filename:=Path & ThisFile & ".xlsm", FileFormat:=52


Range("A3:D3").ClearContents
Range("B7:B28").ClearContents
Range("B40:B50").ClearContents

'close workbook without saving
ActiveWorkbook.Close savechanges:=False

End If
End Sub

 

[nemmi69]

How to close original workbook

Sub CloseOrig()
Dim Wb As Workbook

Set Wb = ThisWorkbook

Wb.Close

End Sub

 

[garthkh]

How to close original workbook

Sub CloseOrig()
Dim Wb As Workbook

Set Wb = ThisWorkbook

Wb.Close

End Sub

Thank you. I'll add this in

 

[nemmi69]

Your welcome

 

[garthkh]

Your welcome

I'm still having problems with my VBA code output. I'm wanting only the value on the sheet captured and saved. Can I ask if you could give me the code to copy the visible values only in range (A1 to F50) to a new workbook and save the new workbook as a plain xslx file. All the macros, formulas and date calulations etc in the cells are irrelevant for the output and if they can be removed it would help the person opening the end file. By copying only range A1:F50 will also get rid of the troublesome button and the macros behind it. The button is only required to streamline the sheet used for entry.
So this code sort of works but gives problems when opening the saved document.

folder = Range("A3").Value & "\"
'Path = "C:\Users\garth\Desktop\" & folder
Path = "C:\Users\garth\OneDrive\Documents\" & folder

ThisFile = Format(Range("E3").Value, "dd-mm-yyyy") & Range("C3").Value & Range("D3").Value & Range("B3").Value

'ActiveWorkbook.SaveAs filename:=Path & ThisFile & ".xlsm", FileFormat:=52

Worksheets("Day Care Checklist").Copy
'there is now a new active workbook with one sheet only
With ActiveWorkbook
'save it
.SaveAs filename:=Path & ThisFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook
'optionally close it
.Close savechanges:=False
End With

 

[nemmi69]

I copied in to your code

folder = Range("A3").Value & "\"
'Path = "C:\Users\garth\Desktop\" & folder
Path = "C:\Users\garth\OneDrive\Documents\" & folder

ThisFile = Format(Range("E3").Value, "dd-mm-yyyy") & Range("C3").Value & Range("D3").Value & Range("B3").Value

'ActiveWorkbook.SaveAs filename:=Path & ThisFile & ".xlsm", FileFormat:=52

Worksheets("Day Care Checklist").Range("A1:F50").SpecialCells(xlCellTypeVisible).Copy

'there is now a new active workbook with one sheet only
With ActiveWorkbook
'save it
.SaveAs Filename:=Path & ThisFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook
'optionally close it
.Close savechanges:=False
End With