Yes - Dave, but this saves the person filling in the spreadsheet from ttyping
in their name for a bulk load into another program. On occasion there are
around 200 or so items being loaded.

That is why I would like to have this happen after they run the following...
any ideas? By the way - this is part of a job that I have inherited from a
former co-worker, so cleaning it up is also a goal of mine...

Option Explicit

Global Const fileNameColumn = 1
Global Const objNameColumn = 2
Global Const beginRow = 8
Global Const defaultDir = "K:\"

Public Function GetFileName(ByRef filenames() As String) As Boolean

Dim s As String

On Error GoTo CancelError

With UserForm1.CommonDialog1

.filename = ""
.MaxFileSize = 32000
.Filter = " Files|*.*"
.Flags = cdlOFNNoChangeDir
.initDir = defaultDir
.DialogTitle = "Select File"
.CancelError = True
.Flags = cdlOFNAllowMultiselect + cdlOFNExplorer + cdlOFNLongNames
.Action = 1

If Len(Trim(.filename)) 0 Then
s = UCase(.filename)
s = LCase(Replace(s, defaultDir, ""))
filenames = Split(s, vbNullChar)
GetFileName = True
Exit Function
End If

End With

CancelError:

GetFileName = False

End Function


Public Function RemoveExtension(filename As String)

Dim i As Integer
Dim c As String

i = Len(filename)
c = Mid(filename, i, 1)

If InStr(1, filename, ".") Then

While i 0 And c < "."
i = i - 1
c = Mid(filename, i, 1)
Wend

If c = "." Then
RemoveExtension = Mid(filename, 1, i - 1)
Else
RemoveExtension = filename
End If

Else
RemoveExtension = filename
End If

End Function


Public Function FollowsBWDrawingConvention(s As String) As Boolean

Dim prefix As String
Dim suffix As String
Dim rest As String

FollowsBWDrawingConvention = False

If Len(s) < 2 Then Exit Function

prefix = UCase(Mid(s, 1, 1))
rest = Mid(s, 2)
If prefix = "B" And IsNumeric(rest) Then
FollowsBWDrawingConvention = True
Exit Function
End If

suffix = Mid(s, Len(s), 1)
rest = Mid(s, 1, Len(s) - 1)
If (Not IsNumeric(suffix)) And IsNumeric(rest) Then
FollowsBWDrawingConvention = True
Exit Function
End If

End Function

Sub GetFiles()

'inserts cleaned files (K:\) into sheet

Dim z As Integer
Range(Range("A8"), Range("K1000")).ClearContents
With Application.FileSearch
.LookIn = "K:\"
.SearchSubFolders = False
.filename = "*.*"
.Execute

For z = 1 To .FoundFiles.count
Range("A1000").End(xlUp).Offset(1, 0). _
Value = Dir(.FoundFiles(z))
Next z
End With

End Sub




Dave Peterson wrote:
I'd try:
Option Explicit
Function UserNameWindows() As String
UserNameWindows = Environ("USERNAME")
End Function
Sub AutoFillIn()
Dim myNames As Variant
Dim c As Range
Dim res As Variant

myNames = Array("dadunlap", "slhull", "mdringler", _
"sljackson", "ccparker", "thenry", _
"rdowling", "jslong", "mhjames", _
"lndavis", "jdscott", "jfullem", _
"alwrinch")

For Each c In Range("A8:A1000")
If c.Value = "" Then
Exit For
End If
c.Offset(0, 8).Formula = "=UserNameWindows()"
res = Application.Match(UserNameWindows, myNames, 0)
If IsNumeric(res) Then
'found it
c.Offset(0, 6).Value = "YES"
Else
c.Offset(0, 6).Value = "NO"
End If
Next c
End Sub

====
But isn't this putting the same value in those offset cells for each row?

I have a Sub that will not end? Any ideas...

[quoted text clipped - 32 lines]
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200708/1


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200708/1