Create new folder based on cell values

[zovche]

Hello,

I would like to create new folder with folder name based on cells in excel (like Range("M1") & "_" & Range("D2")).

Example path:

"XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
Where:
M1=123456
D2=Test
so I get folder "XA\DT\1. PROTEH\123456_Test"

If folder exists it would be great to skip and continue with rest of the code, I would like to avoid overwriting if folder exists and to avoid break message stopping the code.

Thanks.

Thank you.

 

[Fishboy]

Hello,

I would like to create new folder with folder name based on cells in excel (like Range("M1") & "_" & Range("D2")).

Example path:

"XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
Where:
M1=123456
D2=Test
so I get folder "XA\DT\1. PROTEH\123456_Test"

If folder exists it would be great to skip and continue with rest of the code, I would like to avoid overwriting if folder exists and to avoid break message stopping the code.

Thanks.

Thank you.

Hi zovche,

Is this any good to you?

Sub CreateFolder()
Dim NewFolder As String
    NewFolder = "XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
        If Len(Dir(NewFolder, vbDirectory)) = 0 Then
           MkDir NewFolder
        Else
            MsgBox "Folder already exists"
        End If
End Sub

 

[zovche]

Hi zovche,

Is this any good to you?

Sub CreateFolder()
Dim NewFolder As String
    NewFolder = "XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
        If Len(Dir(NewFolder, vbDirectory)) = 0 Then
           MkDir NewFolder
        Else
            MsgBox "Folder already exists"
        End If
End Sub

Hi Fishboy,

That's just perfect. I tested multiple combinations and works for any just like I needed.

Thank you very much, I googled some solutions but they were really complicated, I was like it must be something smoother and less complex, so I came here. Thank you once again.

Vlatko

 

[Fishboy]

Hi Fishboy,

That's just perfect. I tested multiple combinations and works for any just like I needed.

Thank you very much, I googled some solutions but they were really complicated, I was like it must be something smoother and less complex, so I came here. Thank you once again.

Vlatko

Happy to help mate. Thanks for the positive feedback

 

[zovche]

Happy to help mate. Thanks for the positive feedback

My pleasure
I just come to one more additional thing related to this
In next step I have another macro where now I would like to save worksheet into that new path.

I tried:

ActiveWorkbook.SaveAs "XA\DT\1. PROTEH\" & Range("M1").Text & "_" & Range("D2").Text & "\" & ActiveWorkbook.Name

And:

NewFolder = "XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
ActiveWorkbook.SaveAs NewFolder & ActiveWorkbook.Name

But didn't work.

 

[Fishboy]

How about this?

Sub SavingWorkbook()
Dim NewFolder As String, SaveName As String
    NewFolder = "XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
        SaveName = ActiveWorkbook.Name & ".xlsm"
            ActiveWorkbook.SaveAs NewFolder  & "\" & SaveName
End Sub

Or you could try combining it all into one macro. If the folder doesn't exist, create it then save the file. If the folder already exists, just save the file.

Sub BothInOne()
Dim NewFolder As String
    NewFolder = "XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
        If Len(Dir(NewFolder, vbDirectory)) = 0 Then
            MkDir NewFolder
                SaveName = ActiveWorkbook.Name & ".xlsm"
                    ActiveWorkbook.SaveAs NewFolder & "\" & SaveName
        Else
                SaveName = ActiveWorkbook.Name & ".xlsm"
                    ActiveWorkbook.SaveAs NewFolder & "\" & SaveName
        End If
End Sub

 

[zovche]

How about this?

Sub SavingWorkbook()
Dim NewFolder As String, SaveName As String
    NewFolder = "XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
        SaveName = ActiveWorkbook.Name & ".xlsm"
            ActiveWorkbook.SaveAs NewFolder  & "\" & SaveName
End Sub

Or you could try combining it all into one macro. If the folder doesn't exist, create it then save the file. If the folder already exists, just save the file.

Sub BothInOne()
Dim NewFolder As String
    NewFolder = "XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
        If Len(Dir(NewFolder, vbDirectory)) = 0 Then
            MkDir NewFolder
                SaveName = ActiveWorkbook.Name & ".xlsm"
                    ActiveWorkbook.SaveAs NewFolder & "\" & SaveName
        Else
                SaveName = ActiveWorkbook.Name & ".xlsm"
                    ActiveWorkbook.SaveAs NewFolder & "\" & SaveName
        End If
End Sub

I tried it but I get same error message:
"Run-time error '1004'
Method 'SaveAs' of object '_Workbook' failed"

On debug mode it marks me this line

ActiveWorkbook.SaveAs NewFolder & "\" & SaveName

 

[Fishboy]

Hmm, strange as both of my suggestions work without issue at this end. Do you have any other workbooks open? If so, are they what Excel would consider the "Active Workbook" instead of the one with the macros in? Are you trying to save as a non-macro enabled workbook instead of a .xlsm?

 

[zovche]

How about this?

Sub SavingWorkbook()
Dim NewFolder As String, SaveName As String
    NewFolder = "XA\DT\1. PROTEH\" & Range("M1") & "_" & Range("D2")
        SaveName = ActiveWorkbook.Name & ".xlsm"
            ActiveWorkbook.SaveAs NewFolder  & "\" & SaveName
End Sub

Ups sorry, I made dummy mistake I miss-type Sheet name from where I take the cell value grrrr at me
Everything's fine now works like a charm any example above.

Worksheets("***").Range("M1") & "_" & Worksheets("***").Range("D2")

Part with asterisks *** was typed wrongly, I was in another sheet and whole the time looking on different name.

Case closed, thanks much for this. Have a great day.

 

[Fishboy]

Ups sorry, I made dummy mistake I miss-type Sheet name from where I take the cell value grrrr at me
Everything's fine now works like a charm any example above.

Worksheets("***").Range("M1") & "_" & Worksheets("***").Range("D2")

Part with asterisks *** was typed wrongly, I was in another sheet and whole the time looking on different name.

Case closed, thanks much for this. Have a great day.

No problem, sometimes simple little mistakes are easily done

Happy to hear you got it all working.