Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Junior Member
 
Posts: 27
Lightbulb a macro with finishing criteria

Hello again,

i have found a bright macro so quick to handle and i like it to perform basically with one last finishing criteria.

In myWorkbook, every sheets have a password, except on mymastersheet.

On protected Sheets, the columns are divided into 2 types.
Protection enabled at columns A~D
Protection disabled at columns E~IV
No ColumnIs are now suggested to be hidden <before or after running macro.

1) Is it possible to prompt this macro while my active sheet is the mymastersheet?
2) If not, then what line should i add/remove/modify in order to make myWorkbook easy to handle. I like the macro, if possible, to reinstate the password protection after running...

----
Sub GetFileDetails()
'Jacob Skaria: 10 Oct 2009
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet

Set fso = CreateObject("Scripting.FileSystemObject")

For Each ws In Worksheets
ws.Range("D1").Resize(ws.Cells(Rows.Count, "A").End(xlUp).Row).Value = "Not found"
ws.Range("D1") = "Status"

If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each fl In folder.Files

Set rngFound = ws.Range("A:A").Find(fl.Name, LookAt:=xlPart)

If rngFound Is Nothing Then
ws.Range("A" & lngRow).Formula = "=hyperlink(""" & folder.Path & "\" & fl.Name & """,""" & fl.Name & """)"
ws.Range("B" & lngRow) = fl.Size
ws.Range("C" & lngRow) = fl.DateLastModified
ws.Range("D" & lngRow) = "New"
lngRow = lngRow + 1
Else
If ws.Range("B" & rngFound.Row) = fl.Size And ws.Range("C" & rngFound.Row) = fl.DateLastModified Then
ws.Range("D" & rngFound.Row) = "No change"
Else
ws.Range("D" & rngFound.Row) = "Modified"
End If
End If
Next

End If
Next
End Sub
----

finishing ideas are well appreciaIed :)

--
regards
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 8,520
Default a macro with finishing criteria

Try the below...

Sub GetFileDetails()
'Jacob Skaria: 10 Oct 2009
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet
Dim strPassword As String
Set fso = CreateObject("Scripting.FileSystemObject")

If ActiveSheet.Name = "mymastersheet" Then
strPassword = InputBox("Enter password")
Else: Exit Sub: End If

For Each ws In Worksheets
ws.Unprotect Password:=strPassword
ws.Range("D1").Resize(ws.Cells(Rows.Count, _
"A").End(xlUp).Row).Value = "Not found"
ws.Range("D1") = "Status"

If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each fl In folder.Files

Set rngFound = ws.Range("A:A").Find(fl.Name, LookAt:=xlPart)

If rngFound Is Nothing Then
ws.Range("A" & lngRow).Formula = _
"=hyperlink(""" & folder.Path & _
"\" & fl.Name & """,""" & fl.Name & """)"
ws.Range("B" & lngRow) = fl.Size
ws.Range("C" & lngRow) = fl.DateLastModified
ws.Range("D" & lngRow) = "New"
lngRow = lngRow + 1
Else
If ws.Range("B" & rngFound.Row) = fl.Size And _
ws.Range("C" & rngFound.Row) = fl.DateLastModified Then
ws.Range("D" & rngFound.Row) = "No change"
Else
ws.Range("D" & rngFound.Row) = "Modified"
End If
End If
Next

End If
ws.Protect Password:=strPassword
Next
End Sub


If this post helps click Yes
---------------
Jacob Skaria


"driller2" wrote:


Hello again,

i have found a bright macro so quick to handle and i like it to perform
basically with one last finishing criteria.

In myWorkbook, every sheets have a password, except on mymastersheet.

On protected Sheets, the columns are divided into 2 types.
Protection enabled at columns A~D
Protection disabled at columns E~IV
No ColumnIs are now suggested to be hidden <before or after running
macro.

1) Is it possible to prompt this macro while my active sheet is the
mymastersheet?
2) If not, then what line should i add/remove/modify in order to make
myWorkbook easy to handle. I like the macro, if possible, to reinstate
the password protection after running...

----
Sub GetFileDetails()
'Jacob Skaria: 10 Oct 2009
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet

Set fso = CreateObject("Scripting.FileSystemObject")

For Each ws In Worksheets
ws.Range("D1").Resize(ws.Cells(Rows.Count, "A").End(xlUp).Row).Value =
"Not found"
ws.Range("D1") = "Status"

If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each fl In folder.Files

Set rngFound = ws.Range("A:A").Find(fl.Name, LookAt:=xlPart)

If rngFound Is Nothing Then
ws.Range("A" & lngRow).Formula = "=hyperlink(""" & folder.Path &
"\" & fl.Name & """,""" & fl.Name & """)"
ws.Range("B" & lngRow) = fl.Size
ws.Range("C" & lngRow) = fl.DateLastModified
ws.Range("D" & lngRow) = "New"
lngRow = lngRow + 1
Else
If ws.Range("B" & rngFound.Row) = fl.Size And ws.Range("C" &
rngFound.Row) = fl.DateLastModified Then
ws.Range("D" & rngFound.Row) = "No change"
Else
ws.Range("D" & rngFound.Row) = "Modified"
End If
End If
Next

End If
Next
End Sub
----

finishing ideas are well appreciaIed :)

--
regards




--
driller2

  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 7
Default a macro with finishing criteria

Tried and it works great..
i will keep on testing it . :)

thank you with coming appreciation...

--
regards

"Jacob Skaria" wrote:

Try the below...

Sub GetFileDetails()
'Jacob Skaria: 10 Oct 2009
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet
Dim strPassword As String
Set fso = CreateObject("Scripting.FileSystemObject")

If ActiveSheet.Name = "mymastersheet" Then
strPassword = InputBox("Enter password")
Else: Exit Sub: End If

For Each ws In Worksheets
ws.Unprotect Password:=strPassword
ws.Range("D1").Resize(ws.Cells(Rows.Count, _
"A").End(xlUp).Row).Value = "Not found"
ws.Range("D1") = "Status"

If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each fl In folder.Files

Set rngFound = ws.Range("A:A").Find(fl.Name, LookAt:=xlPart)

If rngFound Is Nothing Then
ws.Range("A" & lngRow).Formula = _
"=hyperlink(""" & folder.Path & _
"\" & fl.Name & """,""" & fl.Name & """)"
ws.Range("B" & lngRow) = fl.Size
ws.Range("C" & lngRow) = fl.DateLastModified
ws.Range("D" & lngRow) = "New"
lngRow = lngRow + 1
Else
If ws.Range("B" & rngFound.Row) = fl.Size And _
ws.Range("C" & rngFound.Row) = fl.DateLastModified Then
ws.Range("D" & rngFound.Row) = "No change"
Else
ws.Range("D" & rngFound.Row) = "Modified"
End If
End If
Next

End If
ws.Protect Password:=strPassword
Next
End Sub


If this post helps click Yes
---------------
Jacob Skaria


"driller2" wrote:


Hello again,

i have found a bright macro so quick to handle and i like it to perform
basically with one last finishing criteria.

In myWorkbook, every sheets have a password, except on mymastersheet.

On protected Sheets, the columns are divided into 2 types.
Protection enabled at columns A~D
Protection disabled at columns E~IV
No ColumnIs are now suggested to be hidden <before or after running
macro.

1) Is it possible to prompt this macro while my active sheet is the
mymastersheet?
2) If not, then what line should i add/remove/modify in order to make
myWorkbook easy to handle. I like the macro, if possible, to reinstate
the password protection after running...

----
Sub GetFileDetails()
'Jacob Skaria: 10 Oct 2009
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet

Set fso = CreateObject("Scripting.FileSystemObject")

For Each ws In Worksheets
ws.Range("D1").Resize(ws.Cells(Rows.Count, "A").End(xlUp).Row).Value =
"Not found"
ws.Range("D1") = "Status"

If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each fl In folder.Files

Set rngFound = ws.Range("A:A").Find(fl.Name, LookAt:=xlPart)

If rngFound Is Nothing Then
ws.Range("A" & lngRow).Formula = "=hyperlink(""" & folder.Path &
"\" & fl.Name & """,""" & fl.Name & """)"
ws.Range("B" & lngRow) = fl.Size
ws.Range("C" & lngRow) = fl.DateLastModified
ws.Range("D" & lngRow) = "New"
lngRow = lngRow + 1
Else
If ws.Range("B" & rngFound.Row) = fl.Size And ws.Range("C" &
rngFound.Row) = fl.DateLastModified Then
ws.Range("D" & rngFound.Row) = "No change"
Else
ws.Range("D" & rngFound.Row) = "Modified"
End If
End If
Next

End If
Next
End Sub
----

finishing ideas are well appreciaIed :)

--
regards




--
driller2

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Help generating score from finishing position Dan Excel Worksheet Functions 7 March 3rd 09 06:36 AM
Macro not finishing due to loading workbook David P. Excel Discussion (Misc queries) 7 October 14th 08 07:55 PM
Finishing my Address Lookup Few more questions[_2_] Excel Discussion (Misc queries) 1 February 19th 07 06:44 PM
Help finishing array formula! Pat Flynn Excel Worksheet Functions 4 November 6th 06 07:12 PM
Crashing when finishing charts wruwtrix Excel Discussion (Misc queries) 1 September 14th 05 02:10 AM


All times are GMT +1. The time now is 10:17 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"