Dave...Your code works although I found one issues with my data. Several
companies have multiple offices in the same location. So when the folder is
created and the code attempts to create the next company folder I get an
error because it is attempting to create a folder with the same name and
city. Is there away I can append a number to the folder based on some sort of
count to make the folder unique? E.g.

Column A- Column F(#)
TVC Capital LLC-Del Mar(1)
TVC Capital LLC-Del Mar(2)

I have several hundred companies with multiple branches in the same City.
Thanks for your assistance.
Kerry

"Dave Peterson" wrote:

Maybe...

Sub StartHere()

Dim rCell As Range
Dim rRng As Range

with Sheet1
set rRng = .range("A2",.cells(.rows.count,"A").end(xlup))
end with

For Each rCell In rRng.Cells
CreateFolders rCell.Value & "-" & rcell.offset(0,5).value, "C:\Test"
Next rCell

End Sub

rCell is in column A. .offset(0,5) is 5 columns to the right (column F).

Kerry wrote:

I have this code that loops through my worksheet and create new folders. I
need to use multiple columns to create my folder such as CompanyName in
Column A and CompanyCity in Column F. I would like to use a dash or
parentecies between the CompanyName and CompanyCity e.g.
CompanyName-CompanyCity.

Sub StartHere()

Dim rCell As Range, rRng As Range

Set rRng = Sheet1.Range("C2:C100")

For Each rCell In rRng.Cells
CreateFolders rCell.Value, "C:\Test"
Next rCell

End Sub

Sub CreateFolders(sSubFolder As String, ByVal sBaseFolder As String)

Dim sTemp As String

'Make sure the base folder is ready to have a sub folder
'tacked on to the end
If Right(sBaseFolder, 1) < "\" Then
sBaseFolder = sBaseFolder & "\"
End If

'Make sure base folder exists
If Len(Dir(sBaseFolder, vbDirectory)) 0 Then
'Replace illegal characters with an underscore
sTemp = CleanFolderName(sSubFolder)
'See if already exists: Thanks Dave W.
If Len(Dir(sBaseFolder & sTemp)) = 0 Then
'Use MkDir to create the folder
MkDir sBaseFolder & sTemp
End If
End If

End Sub

Function CleanFolderName(ByVal sFolderName As String) As String

Dim i As Long
Dim sTemp As String

For i = 1 To Len(sFolderName)
Select Case Mid$(sFolderName, i, 1)
Case "/", "\", ":", "*", "?", "<", "", "|"
sTemp = sTemp & "_"
Case Else
sTemp = sTemp & Mid$(sFolderName, i, 1)
End Select
Next i

CleanFolderName = sTemp

End Function

--

Dave Peterson