How to extract data from File Path

[DK]

I have extracted a directory listing like:
I:\Account_Documents\ABC\ABCXYZ\GOV Documents

I want to extract the third directory (ABC) into one column and fourth
directory (ABCXYZ) in another column from the whole.

How can I do this quickly?

 

[Ron de Bruin]

Hi DK

Why not use Data>Text to columns in the menubar

 

[DK]

That would extract all the data which has \ as separator in the
columns. I just want 3rd and 4th. There is no specific length of the
text. If there had been, I would have used MID.

 

[Jim Cone]

Another approach...

Sub tested()
Dim str As String
Dim var As Variant
str = "I:\Account_Documents\ABC\ABCXYZ\GOV Documents"
'zero based array is returned by the Split function.
var = VBA.Split(str, "\", -1)
MsgBox var(2) & vbCr & var(3)
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"DK" <[email protected]>
wrote in message I have extracted a directory listing like:
I:\Account_Documents\ABC\ABCXYZ\GOV Documents
I want to extract the third directory (ABC) into one column and fourth
directory (ABCXYZ) in another column from the whole.

How can I do this quickly?

 

[Ron de Bruin]

See Jim's reply

 

[DK]

Jim,
Where are we specifying the column that would have the result? I don't
need it to show up in a Msg Box. I have about 35000 rows which have
the same kind of format. The File Path data is in Column D and the
data needs to be extracted in Col G & H.

 

[Jim Cone]

For Each rCell in rngCol.Cells
var = VBA.Split(rCell.Text, "\", -1)
rCell.Offset(0, 3).Value = var(2)
rCell.Offset(0, 4).Value = var(3)
Next
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"DK" <[email protected]>
wrote in message
Jim,
Where are we specifying the column that would have the result? I don't
need it to show up in a Msg Box. I have about 35000 rows which have
the same kind of format. The File Path data is in Column D and the
data needs to be extracted in Col G & H.

 

[DK]

Hi Jim
Thanks for your help!!

I have modified the code to this:-
Sub Macro2()
'
Dim var As Variant
For Each rCell In Range("D265536")
var = VBA.Split(rCell.Text, "\", -1)
rCell.Offset(0, 3).Value = var(2)
rCell.Offset(0, 4).Value = var(3)
Next
End Sub

It extracted the values but gives me an error Subscript out of range.
Am I doing something wrong?

Thanks again!!

 

[Jim Cone]

How can it extract the values and yet still give an error?
On what line does the error occur?
I suspect you have some short file paths and var(3) does not exist.
'--
Use Option Explicit at the top ot the module.
Declare all variables
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"DK" <[email protected]>
wrote in message
Hi Jim
Thanks for your help!!

I have modified the code to this:-
Sub Macro2()
'
Dim var As Variant
For Each rCell In Range("D265536")
var = VBA.Split(rCell.Text, "\", -1)
rCell.Offset(0, 3).Value = var(2)
rCell.Offset(0, 4).Value = var(3)
Next
End Sub

It extracted the values but gives me an error Subscript out of range.
Am I doing something wrong?

Thanks again!!

 

[Guest]

Hi DK,

As Jim states, your code doesn't declare all the variables.
Also, you are specifying 65536 rows in the range, which is more than the
35000 you stated earlier. The Split() function is causing problems with empty
cells. You might want to include a conditional, and specify the last row.

Try:

Option Explicit

'To add to Jim's suggestion:
'
'If you want to create a full directory path in separate columns then modify
Jim's code as follows..

Sub tested()
Dim str As String, sPath1 As String, sPath2 As String
Dim var As Variant
Dim rCell As Range, rngCol As Range
Dim lLastRow As Long, r As Long

str = InputBox("Enter the range to start extracting the path data from")
If str = "" Then Exit Sub '//user cancels
With ActiveSheet
lLastRow = .Cells(Rows.Count, .Range(str).Column).End(xlUp).Row
Set rngCol = .Range(str).EntireColumn
End With

With rngCol
For r = 2 To lLastRow
'zero based array is returned by the Split function.
If Not .Cells(r, 1) = "" Then
var = VBA.Split(.Cells(r).Text, "\", , vbTextCompare)

sPath1 = var(0) & "\" & var(1) & "\" & var(2)
sPath2 = sPath1 & "\" & var(3)

' .Cells(r, 1).Offset(0, 3).Value = var(2)
.Cells(r, 1).Offset(0, 3).Value = sPath1
' .Cells(r, 1).Offset(0, 4).Value = var(3)
.Cells(r, 1).Offset(0, 4).Value = sPath2
End If
Next
End With
End Sub

hth
Best regards,
Garry

 

[Rick Rothstein \(MVP - VB\)]

I have modified the code to this:-

Sub Macro2()
'
Dim var As Variant
For Each rCell In Range("D265536")
var = VBA.Split(rCell.Text, "\", -1)
rCell.Offset(0, 3).Value = var(2)
rCell.Offset(0, 4).Value = var(3)
Next
End Sub

It extracted the values but gives me an error Subscript out of range.
Am I doing something wrong?

If Garry (GS) is right and you simply ran into empty the rows after your
data, you could modify your code like this...

Sub Macro2()
Dim var As Variant
For Each rCell In Range("D265536")
var = VBA.Split(rCell.Text, "\", -1)
If Ubound(var) < 0 Then Exit For ' or perhaps Exit Sub
rCell.Offset(0, 3).Value = var(2)
rCell.Offset(0, 4).Value = var(3)
Next
End Sub

Rick

 

[Guest]

Hi Rick,

As long as there are no blanks between the first and last rows.., your
suggestion is nice and simple.

I considered the existence of blank cells/rows a possibility so wrote code
accordingly. It seems to work without error when tested with various contents
in the source range, nicely skipping over any empty cells.

Best regards,
Garry

 

[DK]

Hi Garry ! Hello Rick!
There are no blank rows in the data except at the end.

Secondly, I tried both the things.

Garry, when I tried your code, it is extracting the first three
folders in column g. I only want the third folder. Similarly for
column H.

I still got the error, subscript out of range and I found out what is
causing it.

Rick, I got the error with this code too.

There is one directory which does not have a sub directory and that is
where the macro stops.

Can you please assist in rectifying this?

 

[Guest]

DK,
Comment out the lines I added to Jim's code and uncomment his lines. This
will give you the folder only.

As for the error you're getting, I suspect that not all the path data values
are structured the same. I'll play with this and post back, but I think if
you add Rick's suggestion to the If... statement using the AND operator it
might be what you need. For example:

If Not .Cells(r, 1) = "" And UBound(var) > 2 Then

GS
---

 

[Guest]

Here ya go..
Sub tested3()
Dim str As String
Dim var As Variant
Dim rngCol As Range
Dim lLastRow As Long, r As Long

str = InputBox("Enter the range to start extracting the path data from")
If str = "" Then Exit Sub '//user cancels
With ActiveSheet
lLastRow = .Cells(Rows.Count, .Range(str).Column).End(xlUp).Row
Set rngCol = .Range(str).EntireColumn
End With

With rngCol
For r = 2 To lLastRow
'zero based array is returned by the Split function.
If Not .Cells(r, 1) = "" Then
var = VBA.Split(.Cells(r).Text, "\", , vbTextCompare)
If UBound(var) > 2 Then
.Cells(r, 1).Offset(0, 3).Value = var(2)
.Cells(r, 1).Offset(0, 4).Value = var(3)
End If
End If
Next
End With
End Sub

Regards,
Garry

 

[DK]

Hello Garry,
This worked like a charm!! Thank you so much for your help!!

Thank you all for bailing me out!

Regards
DK

 

[Ron Rosenfeld]

I have extracted a directory listing like:
I:\Account_Documents\ABC\ABCXYZ\GOV Documents

I want to extract the third directory (ABC) into one column and fourth
directory (ABCXYZ) in another column from the whole.

How can I do this quickly?

Here's yet another approach. It "works on" a range of Selected Cells, and puts
the "extracts" in the adjacent two columns:


===================================
Option Explicit
Sub Extract()
Dim c As Range
Dim oRegex As Object
Dim mcMatchCollection As Object

Set oRegex = CreateObject("VBScript.RegExp")
With oRegex
.Global = True
.IgnoreCase = True
.Pattern = "[\\]([^\\]*)"
End With

For Each c In Selection
With c
.Offset(0, 1).Clear
.Offset(0, 2).Clear
If oRegex.Test(.Text) = True Then
Set mcMatchCollection = oRegex.Execute(.Text)
.Offset(0, 1).Value = mcMatchCollection(1).SubMatches(0)
.Offset(0, 2).Value = mcMatchCollection(2).SubMatches(0)
End If
End With
Next c

End Sub
==================================
--ron