Creating directories from given column of data

[Kelly]

Hi all,

I'm very new at VBA and am trying to figure out how to create a macro
that takes the data entered in Column A and then generates directories
using the data in each cell in Column A.

Example

A1: Cat
A2: Dog
A3: Snake

Generating directories wherever I designate titled "Cat," "Dog,"
"Snake," etc.

The initial code I have found allows me to generate a directory though
only from "A1"

Sub CreateDirectoy()
Dim strDir As String

strDir = "C:\" & Sheet1.Range("A1")
On Error Resume Next
If Dir(strDir) = "" Then MkDir strDir


End Sub

How do I have this piece of code apply to all of column A?

I know this is surely rudimentary to everyone, so please forgive me in
advance.

Best wishes and many, many thanks,

Kelly






*** Sent via Developersdex http://www.developersdex.com ***

 

[Nigel]

Dim myR As Range, c As Range
Dim strDir As String
Sub CreateDirectoy()
With Sheets("Sheet1")

' get range of valid cells
Set myR = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))

' loop through each cell value
For Each c In myR

' using your code
strDir = "C:\" & Trim(c.Value)
On Error Resume Next
If Dir(strDir) = "" Then MkDir strDir

Next

End With
End Sub

 

[Nigel]

Somehow the code layout got messed up in my previous post, sorry......

Sub CreateDirectoy()
Dim myR As Range, c As Range
Dim strDir As String
With Sheets("Sheet1")

' get range of valid cells
Set myR = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))

' loop through each cell value
For Each c In myR

' using your code
strDir = "C:\" & Trim(c.Value)
On Error Resume Next
If Dir(strDir) = "" Then MkDir strDir

Next

End With
End Sub


--

Regards,
Nigel
(e-mail address removed)

 

[Kelly]

Aloha Nigel,

Thank you so very much for assisting me with my VBA question. I've
implemented your script and have just one question. What portion of the
code do I need to edit in order to dictate the column of data I would
like processed? As it is, Column A is the default. What would I change
if I needed to use Column Q or AQ, etc.?

All the best,

Kelly



*** Sent via Developersdex http://www.developersdex.com ***

 

[Nigel]

This is the original....... for column A

Set myR = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))

add the following to allow a more universal approach

Dim mFirstRow as Long, mDataCol as String
mFirstRow = 1 ' this is the first row of directory names
mDataCol = "Q" ' this is the column of names to use

Set myR = .Range(.Cells(mFirstRow, mDataCol), .Cells(Rows.Count,
mDatCol).End(xlUp))

 

[Kelly]

Many thanks again, Nigel, for taking the time to review my post.

I attempted to substitute the new code you posted in place of the
original Column A specific code. I'm getting a run time error and
imagine I've screwed the placement up.

Sub CreateDirectoy()
Dim myR As Range, c As Range
Dim strDir As String
Dim mFirstRow As Long, mDataCol As String
mFirstRow = 1 ' this is the first row of directory names
mDataCol = "B" ' this is the column of names to use
With Sheets("Sheet1")

Set myR = .Range(.Cells(mFirstRow, mDataCol), .Cells(Rows.Count,
mDatCol).End(xlUp))

' loop through each cell value
For Each c In myR

' using your code
strDir = "C:\Documents and Settings\Administrator\Desktop\FOLDERS\"
& Trim(c.Value)
On Error Resume Next
If Dir(strDir) = "" Then MkDir strDir

Next

End With
End Sub


Anything look out of place?

*** Sent via Developersdex http://www.developersdex.com ***

 

[carlo]

Did you repair all wordwraps?
Because of the length of some lines, the code is broken in those two
lines starting with* "Set myR =" and "strDir =" the following line
should actually be on the same line. otherwise, try to copy this:

Sub CreateDirectoy()
Dim myR As Range, c As Range
Dim strDir As String
Dim mFirstRow As Long, mDataCol As String
mFirstRow = 1 ' this is the first row of directory names
mDataCol = "B" ' this is the column of names to use

With Sheets("Sheet1")

Set myR = .Range(.Cells(mFirstRow, mDataCol), .Cells(Rows.Count, _
mDataCol).End(xlUp))

' loop through each cell value
For Each c In myR

' using your code
strDir = "C:\Documents and Settings\Administrator\Desktop\FOLDERS
\" _
& Trim(c.Value)
On Error Resume Next
If Dir(strDir) = "" Then MkDir strDir

Next

End With
End Sub

and there was a typo...there was a "a" missing in the "set myR =" line

Cheers Carlo

 

[Nigel]

Other than checking for word wraps as suggested by Carlo if all looks OK.

In the VBE (Press Alt-F11) and check that the error detection is set
correctly, goto Tools > Options > General (tab) and set Error Trapping to
'Break on Unhandled Errors'.

 

[carlo]

Don't forget the typo:

Set myR = .Range(.Cells(mFirstRow, mDataCol), .Cells(Rows.Count,
mDatCol).End(xlUp))

should be

Set myR = .Range(.Cells(mFirstRow, mDataCol), .Cells(Rows.Count,
mDataCol).End(xlUp))


Carlo

 

[Nigel]

Well spotted!

--

Regards,
Nigel
(e-mail address removed)



Don't forget the typo:

Set myR = .Range(.Cells(mFirstRow, mDataCol), .Cells(Rows.Count,
mDatCol).End(xlUp))

should be

Set myR = .Range(.Cells(mFirstRow, mDataCol), .Cells(Rows.Count,
mDataCol).End(xlUp))


Carlo

 

[Kelly]

Many many thanks Nigel and Carlo!

Lots of karmic goodness coming your way!

Best wishes,

Kelly



*** Sent via Developersdex http://www.developersdex.com ***