Search all workbooks in a specified folder and return the desired cell value and file name

**Ravana** · 01-25-2015, 06:58 AM

Hi everyone!!

I have 100+ excel workbooks in a folder with multiple sheets in each workbook. I am in need for a vb macro code that would search/loop through all the workbooks in a specified sheet and return a specified cell value.

Ex:
I have workbooks like apple, banana, cocoa, mango, orange. Each of these work book have a sheet named sales and in that sheet [sales] there is a cell "m6" and i need that value in a separate workbook where i want to run this code. Along with value from "m6" i need the name of the workbook from where that value is extracted.

Data should look like
s no sheet name value

additionally:
If i can add hyperlink to the value, it would be easier and wiser to open if i needed to make any correction.

Honestly, i tried google but to no avail. I couldn't find any code tailored to my needs. Hence, i turned towards this.

Thanks in advance.

**Brendan_Floyde** · 01-25-2015, 07:26 AM

Are all the workbooks named similarly e.g. sales1 , sales2 etc or do you already know all the workbook names? If so you don't need VBA for this. You can construct a summary sheet using standard excel functions utilizing the indirect() function to build the path to each workbook.

If you don't know the file names then you can run some code to get them and then build the summary sheet as per above.

The basic code for looping through a directory is something like this:

Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\???\???\"
Filename = Dir(Path & "*.xlsm")
'--------------------------------------------

 Do While Len(Filename) > 0  
    Set wbk = Workbooks.Open(Path & Filename)

'Do what ever here to wbk
  

    wbk.Close True
    Filename = Dir
Loop
End Sub

Although in your case you don't need to open the files just return the full paths to the summary sheet.

You probably want to mock up some dummy sheets and post them to get a better response.

**Ravana** · 01-25-2015, 07:32 AM

No all workbooks are named differently. So a code is needed that can loop through each file (without opening) return the desired cell value from the worksheet.

Sorry to bother but, I am novice to programming so I don't know how to write a code. All I do is copy it and run it.

**Brendan_Floyde** · 01-25-2015, 08:25 AM

This just lists the files in a list from the active cell. Obviously replace the ????? with the directory - path must end with a \


Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\?????\"
Filename = Dir(Path & "*.xlsx")
'--------------------------------------------

 Do While Len(Filename) > 0
   
   ActiveCell.Value = Filename
   ActiveCell.Offset(1, 0).Select
   
   
    Filename = Dir
Loop
End Sub

**Brendan_Floyde** · 01-25-2015, 10:29 AM

Added in the hyperlink bit ....thanks Vikas!

Note no need to open base files , therefore quicker. You can add in



Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\??????\"
Filename = Dir(Path & "*.xlsx")
'--------------------------------------------

 Do While Len(Filename) > 0
   
   ActiveCell.Value = Filename
   ActiveCell.Offset(0, 1).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
   ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 2), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
   ActiveCell.Offset(1, 0).Select
   
   Filename = Dir
Loop
End Sub

**Brendan_Floyde** · 01-25-2015, 09:00 AM

Thinking about it if you run the macro you might as well build link as well - try this:

From memory I think when you use Indirect you have to open all the workbooks so not the greatest suggestion!


Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\?????\"
Filename = Dir(Path & "*.xlsx")
'--------------------------------------------

 Do While Len(Filename) > 0
   
   ActiveCell.Value = Filename
   ActiveCell.Offset(0, 1).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
   ActiveCell.Offset(1, 0).Select
   
   
    Filename = Dir
Loop
End Sub

**Vikas_Gautam** · 01-25-2015, 09:29 AM

Okay, Here is the code.. ( Untested Though )

Okay Here is the code.
I have tested it and its working as well.
Note:- Change the Folder Path in the code before running the code.

Sub Fetching_Hyperlinking()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim wbThis As Worksheet, wbThat As Worksheet
    Set wbThis = ActiveSheet
    FPath = "D:\Folder_Path" & "\" 'Change the Folder Path before running the code
    FName = Dir(FPath & "*.xls*")
    r = 2
    
    Do While FName <> ""
        Set wbThat = Workbooks.Open(FPath & FName).Sheets("sales")
        wbThis.Cells(r, 1) = FName
        wbThis.Cells(r, 2) = wbThat.Range("M6")
        wbThis.Hyperlinks.Add Anchor:=wbThis.Cells(r, 3), _
                              Address:=FPath & FName, _
                              SubAddress:="'" & wbThat.Name & "'!M6", _
                              TextToDisplay:="Go to Sheet"
        r = r + 1
        Workbooks(FName).Close False
        FName = Dir
        wb = wb + 1
        Application.StatusBar = wb & " workbooks done..!"
        DoEvents
    Loop
    
    Application.StatusBar = ""
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Finished", vbInformation
End Sub

**Vikas_Gautam** · 01-25-2015, 01:01 PM

Yes, Bendon.. Nice coding..
But workbook has to update links that may take a some time..
rest all looks fine...

**Ravana** · 01-25-2015, 02:42 PM

HI VIKAS

I copied your code into a new Workbook while modifying the directory path. After running the code, there isn't any data fetched from the workbooks is being displayed but only showing the number of files done in the status bar.

Am i doing something wrong. I copied the code into 'thisWorkbook' page in vba.

Guide me.

Thanks in anticipation,

**Ravana** · 01-25-2015, 02:43 PM

HI VIKAS

I copied your code into a new Workbook while modifying the directory path. After running the code, there isn't any data fetched from the workbooks is being displayed but only showing the number of files done in the status bar.

Am i doing something wrong. I copied the code into 'thisWorkbook' page in vba.

Guide me.

Thanks in anticipation,

**Vikas_Gautam** · 01-26-2015, 03:36 AM

Well, That was working for me..
Don't place the Code file in the Same folder where Source files are kept..

Suggestions:-
Try inserting a new Module in Vba..
What about Hyper links..? Aren't they working...?

Or Attach a zip file having your Code file and some individual source files..

**Ravana** · 01-26-2015, 04:54 AM

Hi Vikas !!

By inserting in module and placing it outside the source directory it worked..Thanks a ton...!!

May I ask, if I had to add title to each column, how should i tweak the code. Like first colum displays the 'name of the file' second column 'sales values'.

Thanks once again..!!

**Vikas_Gautam** · 01-26-2015, 07:29 AM

Add this lines to the code after r = 2.

With wbThis
 .Cells(1, 1) = "Name" 
 .Cells(1, 2) = "Value"
 .Cells(1, 3) = "Hyperlinks"
End with

Change the column head accordingly..

**Ravana** · 01-26-2015, 09:51 AM

Heah Vikas

I used your code but it is taking heavy toll on the cpu performance for it is opening each file and then extracting the values. However, the code provided by Brendan worked like swift, for it doesn't open the work books and it is much swifter.

However, the issues with Brendan code is that I cannot add headings as done with your code. I added the below code after loop in Brendan code.

For Each ws In Worksheets
ws.Range("a1:c1") = Array("FILE NAME", "Sales values", "Hyperlinks")
Next ws

The issue is the when I run Brendan code, it starts from A1 and I am unable to adjust the offset values. Can you help me here.

**Brendan_Floyde** · 01-26-2015, 11:46 AM

Not the most eloquent code in the world but should get the job done.................


Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\??????\"
Filename = Dir(Path & "*.xlsx")
'--------------------------------------------

Activecell.value = "File Name"
Activecell.offset(0,1).value = "Sales Values"
Activecell.offset(0,2).value = "Hyperlinks"
ActiveCell.Offset(1, 0).Select

 Do While Len(Filename) > 0
   
   ActiveCell.Value = Filename
   ActiveCell.Offset(0, 1).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
   ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 2), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
   ActiveCell.Offset(1, 0).Select
   
   Filename = Dir
Loop
End Sub

**Ravana** · 01-27-2015, 07:49 AM

Heah Brendan...!!!

Thanks for the help, it worked majestically. Really thanks a lot..!!

However, File Name is returning with extension and other parameters that are associated with it. I just want the file name..is there any way for that??

ex: Mango_April_2014_Final Figure is my file name in the system and what the code is returning is Mango_April_2014_Final Figure.xlsm.

What I intent is only "Mango", not all the trailing part. Is there any way..??

Thanks in anticipation..!!

**Vikas_Gautam** · 01-26-2015, 01:19 PM

Here is amended code..

Sub Fetching_Hyperlinking()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim wbThis As Worksheet
    Set wbThis = ActiveSheet
    FPath = "D:\Folder_Path" & "\" 'Change the Folder Path before running the code
    FName = Dir(FPath & "*.xls*")
    r = 2
    
   'Putting column Heads...
   With wbThis
    .Cells(1, 1) = "Name" 
    .Cells(1, 2) = "Value"
    .Cells(1, 3) = "Hyperlinks"
   End with

    Do While FName <> ""
        wbThis.Cells(r, 1) = FName
        wbThis.Cells(r, 2).Formula = "='" & FPath & "[" & FName & "]sales'!$M$6"
        wbThis.Hyperlinks.Add Anchor:=wbThis.Cells(r, 3), _
                              Address:=FPath & FName, _
                              SubAddress:="Sales'!M6", _
                              TextToDisplay:="Go to Sheet"
        r = r + 1
        FName = Dir
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Finished", vbInformation
End Sub

**caroleo** · 05-06-2015, 04:51 PM

[QUOTE=Vikas_Gautam;3968477]Here is amended code..

Sub Fetching_Hyperlinking()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim wbThis As Worksheet
    Set wbThis = ActiveSheet
    FPath = "D:\Folder_Path" & "\" 'Change the Folder Path before running the code
    FName = Dir(FPath & "*.xls*")
    r = 2
    
   'Putting column Heads...
   With wbThis
    .Cells(1, 1) = "Name" 
    .Cells(1, 2) = "Value"
    .Cells(1, 3) = "Hyperlinks"
   End with

    Do While FName <> ""
        wbThis.Cells(r, 1) = FName
        wbThis.Cells(r, 2).Formula = "='" & FPath & "[" & FName & "]sales'!$M$6"
        wbThis.Hyperlinks.Add Anchor:=wbThis.Cells(r, 3), _
                              Address:=FPath & FName, _
                              SubAddress:="Sales'!M6", _
                              TextToDisplay:="Go to Sheet"
        r = r + 1
        FName = Dir
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Finished", vbInformation
End Sub

[/QUOTE

Vikas_Gautam,

This code comes closest to doing a job that I have been struggling with. I have a folder named "05-MAY 2015" and I have a different folder for each month that contains all shipping tickets for the month. I need to extract 3 cells from each of the workbooks in the folder to summarize all that information at month-end. I would like to have a cell on the resulting workbook that updates the file path with the folder name. At present using your code, I have altered the path to be: "N:\BESI EQUIPMENT DELIVERY TICKETS\05-MAY 2015" & "\". I would like the file name (05-MAY 2015) to be input into a cell on the answer sheet where the selected data is to be accumulated so it can be updated each month. Next, I don't get any data returned, even though I changed your cell no. from M6 to my cell no. J9 (I need 3 cell values returned (J9, D11 and J11) from each Sheet1 in each workbook file, but was trying just to get one (like your code has) to work). I get the file name to print and the hyperlink to print, but the contents of cell J9 just comes back as 0 even though there are numerical and sometimes alpha values in J9. The hyperlink doesn't open the file; although it tries -- it just hangs up; but I don't really need the hyperlink. I am using windows 8.1 and Excel 2013 (64 bit) if that makes a difference. I need, beside the file name, 3 columns of data: 1 is headed "Ship Via", the second is headed "Job No." and the third is headed "Location"; all coming from the 3 cells noted. Any assistance you can give will be greatly appreciated.

**Vikas_Gautam** · 01-26-2015, 01:36 PM

After running the first code...
Copy the following code and paste it in the ThisWorkbook Module:-

Private Sub Workbook_Open()
    Application.AskToUpdateLinks = False
End Sub

Or
You can CHECK the Enable Automatic Updating of External Links in the Trust Settings----->External Content Section
This will be doing the same job of updating links without asking.

**Brendan_Floyde** · 01-27-2015, 08:39 AM

is the delimiter always "_" i.e. you just want whatever is before the first "_" returned?

**Ravana** · 01-27-2015, 09:30 AM

I just want what ever is before first "_". However, sometimes delimiter is "(".

So consider both the cases.

**Brendan_Floyde** · 01-27-2015, 10:24 AM

Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\Users\floydeb\Documents\test\"
Filename = Dir(Path & "*.xlsx")
'--------------------------------------------

ActiveCell.Value = "File Name"
ActiveCell.Offset(0, 1).Value = "Sales Values"
ActiveCell.Offset(0, 2).Value = "Hyperlinks"
ActiveCell.Offset(1, 0).Select

 Do While Len(Filename) > 0
   
 If InStr(1, Filename, "_") <> 0 Then
  ActiveCell.Value = Left(Filename, InStr(1, Filename, "_") - 1)
 ElseIf InStr(1, Filename, "(") <> 0 Then
    ActiveCell.Value = Left(Filename, InStr(1, Filename, "(") - 1)
  ElseIf InStr(1, Filename, ".") <> 0 Then
    ActiveCell.Value = Left(Filename, InStr(1, Filename, ".") - 1)
  Else
   ActiveCell.Value = Filename
 End If
   
   ActiveCell.Offset(0, 1).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
   ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 2), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
   ActiveCell.Offset(1, 0).Select
   
   Filename = Dir
Loop
End Sub

**Ravana** · 01-27-2015, 01:46 PM

That was wonderful Brendan...Thanks a lot for taking your time and helping this novice.

If there are two or more directories should I keep changing path everytime?

I just have a weird thought, if path can be made dynamic, like when I run code, if system asks me for the directory then I can browse and select it. By which way, it will be helpful for everyone who doesn't know vb.

Moreover, we are only looking for .xlsx files in the code, if there are other type of excel files, wouldn't be useful to include all such??

**Brendan_Floyde** · 01-27-2015, 02:35 PM

Try this.....

Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
Path = Left(Path, InStrRev(Path, "\"))
 
Filename = Dir(Path & "*.xls*")
'--------------------------------------------



ActiveCell.Value = "File Name"
ActiveCell.Offset(0, 1).Value = "Sales Values"
ActiveCell.Offset(0, 2).Value = "Hyperlinks"
ActiveCell.Offset(1, 0).Select

 Do While Len(Filename) > 0
   
 If InStr(1, Filename, "_") <> 0 Then
  ActiveCell.Value = Left(Filename, InStr(1, Filename, "_") - 1)
 ElseIf InStr(1, Filename, "(") <> 0 Then
    ActiveCell.Value = Left(Filename, InStr(1, Filename, "(") - 1)
  ElseIf InStr(1, Filename, ".") <> 0 Then
    ActiveCell.Value = Left(Filename, InStr(1, Filename, ".") - 1)
  Else
   ActiveCell.Value = Filename
 End If
   
   ActiveCell.Offset(0, 1).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
   ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 2), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
   ActiveCell.Offset(1, 0).Select
   
   Filename = Dir
Loop
End Sub

**Ravana** · 01-28-2015, 01:31 AM

Done !! Perfect !! Wonderful !!

I love this forum and its members who are so generous to take their time out and help people. Long live Free World. Long Live such people.

Thanks a lot Brendan and Vikas.

Nothing more I required except this last tip- Is there any way to bold the headings.??

**Vikas_Gautam** · 01-28-2015, 03:13 AM

use the following line:-

Activecell.Resize(1,3).font.bold = true

After

ActiveCell.Offset(0, 2).Value = "Hyperlinks"

**Brendan_Floyde** · 01-28-2015, 06:14 AM

Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
Path = Left(Path, InStrRev(Path, "\"))
 
Filename = Dir(Path & "*.xls*")
'--------------------------------------------

With ActiveCell

.Value = "File Name"
.Offset(0, 1).Value = "Sales Values"
.Offset(0, 2).Value = "Hyperlinks"
.Resize(1, 3).Font.Bold = True
.Offset(1, 0).Select

End With

 Do While Len(Filename) > 0
   
 If InStr(1, Filename, "_") <> 0 Then
  ActiveCell.Value = Left(Filename, InStr(1, Filename, "_") - 1)
 ElseIf InStr(1, Filename, "(") <> 0 Then
    ActiveCell.Value = Left(Filename, InStr(1, Filename, "(") - 1)
  ElseIf InStr(1, Filename, ".") <> 0 Then
    ActiveCell.Value = Left(Filename, InStr(1, Filename, ".") - 1)
  Else
   ActiveCell.Value = Filename
 End If
   
   ActiveCell.Offset(0, 1).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
   ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 2), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
   ActiveCell.Offset(1, 0).Select
   
   Filename = Dir
Loop
End Sub

**Ravana** · 02-01-2015, 02:49 AM

Heah Friends, your codes did wonder. I came back again only to request you, if there is any possibility to add borders to entire table?

Plus, since I have many rows, can I add dynamic serial number at the left most column i.e., first column as S.No.

**Brendan_Floyde** · 02-01-2015, 08:03 AM

Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim I As Integer
I = 1
Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
Path = Left(Path, InStrRev(Path, "\"))
 
Filename = Dir(Path & "*.xls*")
'--------------------------------------------

With ActiveCell

.Value = "Serial #"
.Offset(0, 1).Value = "File Name"
.Offset(0, 2).Value = "Sales Values"
.Offset(0, 3).Value = "Hyperlinks"
.Resize(1, 4).Font.Bold = True


End With

 Do While Len(Filename) > 0
 ActiveCell.Offset(1, 0).Select
 ActiveCell.Value = I
 If InStr(1, Filename, "_") <> 0 Then
  ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, "_") - 1)
 ElseIf InStr(1, Filename, "(") <> 0 Then
    ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, "(") - 1)
  ElseIf InStr(1, Filename, ".") <> 0 Then
    ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, ".") - 1)
  Else
   ActiveCell.Offset(0, 1).Value = Filename
 End If
   
   ActiveCell.Offset(0, 2).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
   ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 3), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
   
   
   Filename = Dir
   
   I = I + 1
Loop


    Selection.CurrentRegion.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
End Sub

**Ravana** · 02-02-2015, 05:35 AM

Heah Brendan, code only gave a overall outer border to the table but not a table like look format with each cell bordered.

And serial number is not coming from first row (excluding headers).

Another thing I noticed that, since Sales is number I want it in the format of #,##,###.

Do help.

**Brendan_Floyde** · 02-02-2015, 08:26 AM

Try this ....

Sub Loopthroughdirectory()

Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim I As Integer
I = 1
Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
Path = Left(Path, InStrRev(Path, "\"))
 
Filename = Dir(Path & "*.xls*")
'--------------------------------------------

With ActiveCell

.Value = "Serial #"
.Offset(0, 1).Value = "File Name"
.Offset(0, 2).Value = "Sales Values"
.Offset(0, 3).Value = "Hyperlinks"
.Resize(1, 4).Font.Bold = True


End With

 Do While Len(Filename) > 0
 ActiveCell.Offset(1, 0).Select
 ActiveCell.Value = I
 If InStr(1, Filename, "_") <> 0 Then
  ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, "_") - 1)
 ElseIf InStr(1, Filename, "(") <> 0 Then
    ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, "(") - 1)
  ElseIf InStr(1, Filename, ".") <> 0 Then
    ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, ".") - 1)
  Else
   ActiveCell.Offset(0, 1).Value = Filename
 End If
   
   ActiveCell.Offset(0, 2).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
   ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 3), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
   
   
   Filename = Dir
   
   I = I + 1
Loop


    Selection.CurrentRegion.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
  With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

Selection.Offset(0, 2).Resize(Selection.Rows.Count, 1).Cells.Style = "Comma"
Selection.Cells.EntireColumn.AutoFit

End Sub

not sure what "And serial number is not coming from first row (excluding headers)." this means? What is the problem?

**Ravana** · 02-03-2015, 07:37 AM

The problem of table solved.

However, the other problems is:

Excluding header, there are 10 rows of data and I want serial no for those 10 rows. However, serial no starts from 3rd row i.e., excluding header row and first data row.

Moreover, the cells.style =" comma" changes the header row too. I want change only in data rows but not in header row. The format of "Comma" is giving me 2 trailing zeroes after decimal which looks annoying for a huge data sheet.

**Brendan_Floyde** · 02-03-2015, 07:58 AM

Changed number format - not getting the scenario issue - perhaps post the workbook.

        Sub Loopthroughdirectory()

        Dim wbk As Workbook
        Dim Filename As String
        Dim Path As String
        Dim I As Integer
        I = 1
        Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
        Path = Left(Path, InStrRev(Path, "\"))
         
        Filename = Dir(Path & "*.xls*")
        '--------------------------------------------

        With ActiveCell

        .Value = "Serial #"
        .Offset(0, 1).Value = "File Name"
        .Offset(0, 2).Value = "Sales Values"
        .Offset(0, 3).Value = "Hyperlinks"
        .Resize(1, 4).Font.Bold = True


        End With

         Do While Len(Filename) > 0
         ActiveCell.Offset(1, 0).Select
         ActiveCell.Value = I
         If InStr(1, Filename, "_") <> 0 Then
          ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, "_") - 1)
         ElseIf InStr(1, Filename, "(") <> 0 Then
            ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, "(") - 1)
          ElseIf InStr(1, Filename, ".") <> 0 Then
            ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, ".") - 1)
          Else
           ActiveCell.Offset(0, 1).Value = Filename
         End If
           
           ActiveCell.Offset(0, 2).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
           ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 3), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
           
           
           Filename = Dir
           
           I = I + 1
        Loop


            Selection.CurrentRegion.Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
          With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With

        Selection.Offset(1, 2).Resize(Selection.Rows.Count - 1, 1).Cells.NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
     
        Selection.Cells.EntireColumn.AutoFit

        End Sub

**Ravana** · 02-04-2015, 03:54 AM

Yep. Number format, no more issue. thats' taken care by your code.

However, the serial number issue still persists. Out of 10 lines only 9 lines are being numbered, the first line is not being numbered.

**Brendan_Floyde** · 02-04-2015, 05:39 AM

I've never got that error and I can't think what in the code would do it. so I'm lost. I think in one of your earlier posts you said it was doing 7 out of 10 and now it's 9 out of 10. So i suspect something outside the code. You haven't got the cell format to set white font have you so the text appears hidden or something similar? Could you post the resulting summary table so i can try to replicate?

**Ravana** · 02-04-2015, 03:20 PM

My error. Sorry.

I overlooked the declarations at the start, hence I wasn't getting the desired. Problem solved.

Thanks Brendan, for taking all your time. Really appreciate your generous help. Thanks a lot!!

**Brendan_Floyde** · 02-04-2015, 05:53 PM

No worries - can you mark the thread solved?
-Go to the top of the first post
-Select Thread Tools
-Select Mark thread as Solved

Consider some * rep if i helped.

**Ravana** · 02-12-2015, 02:18 AM

Heab Brendan,

Greetings of the day..!!

Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
        Path = Left(Path, InStrRev(Path, "\"))

This code is allowing me to select which ever folder needed. however, if I cancel without selecting, still it is running the macro.

I do not want macro to run, if I cancel after opening the folder.

**Vikas_Gautam** · 02-12-2015, 05:57 AM

Try this line in the code after Path = Application......

If Not Path then End

**Ravana** · 02-12-2015, 06:06 AM

Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
If Not Path Then End
Path = Left(Path, InStrRev(Path, "\"))

This didn't work.

Giving me error: Run Type error "13", Type mismatch.

**Vikas_Gautam** · 02-12-2015, 06:34 AM

try this then

Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
If Path = False Then End
Path = Left(Path, InStrRev(Path, "\"))

**Ravana** · 02-12-2015, 06:50 AM

Still, macro is running.

**Vikas_Gautam** · 02-12-2015, 06:55 AM

Post your workbook..!

**Brendan_Floyde** · 02-12-2015, 10:27 AM


Sub Loopthroughdirectory()

        Dim wbk As Workbook
        Dim Filename As String
        Dim Path As String
        Dim I As Integer
        I = 1
        Path = Application.GetOpenFilename(, , "Select a file in the Folder you want to list", , False)
        If Path = False Then End
        
        
        Path = Left(Path, InStrRev(Path, "\"))
         
        Filename = Dir(Path & "*.xls*")
        '--------------------------------------------

        With ActiveCell

        .Value = "Serial #"
        .Offset(0, 1).Value = "File Name"
        .Offset(0, 2).Value = "Sales Values"
        .Offset(0, 3).Value = "Hyperlinks"
        .Resize(1, 4).Font.Bold = True


        End With

         Do While Len(Filename) > 0
         ActiveCell.Offset(1, 0).Select
         ActiveCell.Value = I
         If InStr(1, Filename, "_") <> 0 Then
          ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, "_") - 1)
         ElseIf InStr(1, Filename, "(") <> 0 Then
            ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, "(") - 1)
          ElseIf InStr(1, Filename, ".") <> 0 Then
            ActiveCell.Offset(0, 1).Value = Left(Filename, InStr(1, Filename, ".") - 1)
          Else
           ActiveCell.Offset(0, 1).Value = Filename
         End If
           
           ActiveCell.Offset(0, 2).Formula = "='" & Path & "[" & Filename & "]sales'!$M$6"
           ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 3), Address:="" & Path & Filename & "", SubAddress:="sales!m6", TextToDisplay:=Filename
           
           
           Filename = Dir
           
           I = I + 1
        Loop


            Selection.CurrentRegion.Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With
          With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With

        Selection.Offset(1, 2).Resize(Selection.Rows.Count - 1, 1).Cells.NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
     
        Selection.Cells.EntireColumn.AutoFit

        End Sub

**Ravana** · 02-12-2015, 11:19 AM

Luckily this code worked.

If Path = "" Then Exit Sub

**Vikas_Gautam** · 05-08-2015, 05:31 AM

Let First row be heading row having Ship Via in A1, Job No. in B1 and Location in C1.
and E1 for Path(N:\BESI EQUIPMENT DELIVERY TICKETS\) and F1 for Folder Name(05-MAY 2015)

So here is the amended code:-

HTML Code:

Hybrid View

Search all workbooks in a specified folder and return the desired cell value and file name

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Re: Search all workbooks in a specified folder and return the desired cell value and file

Thread Information

Users Browsing this Thread

Similar Threads

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions