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




Function UserNameWindows() As String
UserNameWindows = Environ("USERNAME")
End Function



Sub AutoFillIn()
Dim c As Range
Do Until ActiveCell = ""


For Each c In Range("A8", "A1000")

ActiveCell.Offset(0, 8) = "=UserNameWindows()"

If "USERNAME" = "dadunlap,slhull,mdringler,sljackson,ccparker,
thenry,rdowling,jslong,mhjames,lndavis,jdscott,jfu llem,alwrinch" Then
ActiveCell.Offset(0, 6) = "YES"
Else: ActiveCell.Offset(0, 6) = "NO"
End If

ActiveCell.Offset(1, 0).Select

Next c
Loop
End Sub


Also how can I get this to start at the end of another comand that is started
with ctrl + g. ?

TIA

Rebekah

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

Rebekah,

I'm not sure why you would want to loop: this will work on the activecell's row.


Function UserNameWindows() As String
UserNameWindows = Environ("USERNAME")
End Function

Sub AutoFillIn()
Cells(ActiveCell.Row, 9).Value = UserNameWindows()
If InStr("username string from your example here", UserNameWindows()) 0 Then
Cells(ActiveCell.Row, 7).Value = "YES"
Else
Cells(ActiveCell.Row, 7).Value = "NO"
End If
End Sub


HTH,
Bernie
MS Excel MVP


"RebekahK20_pontiac via OfficeKB.com" <u36479@uwe wrote in message news:772dd83ad1b81@uwe...
I have a Sub that will not end? Any ideas...




Function UserNameWindows() As String
UserNameWindows = Environ("USERNAME")
End Function



Sub AutoFillIn()
Dim c As Range
Do Until ActiveCell = ""


For Each c In Range("A8", "A1000")

ActiveCell.Offset(0, 8) = "=UserNameWindows()"

If "USERNAME" = "dadunlap,slhull,mdringler,sljackson,ccparker,
thenry,rdowling,jslong,mhjames,lndavis,jdscott,jfu llem,alwrinch" Then
ActiveCell.Offset(0, 6) = "YES"
Else: ActiveCell.Offset(0, 6) = "NO"
End If

ActiveCell.Offset(1, 0).Select

Next c
Loop
End Sub


Also how can I get this to start at the end of another comand that is started
with ctrl + g. ?

TIA

Rebekah

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

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?

"RebekahK20_pontiac via OfficeKB.com" wrote:

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

Function UserNameWindows() As String
UserNameWindows = Environ("USERNAME")
End Function


Sub AutoFillIn()
Dim c As Range
Do Until ActiveCell = ""


For Each c In Range("A8", "A1000")

ActiveCell.Offset(0, 8) = "=UserNameWindows()"

If "USERNAME" = "dadunlap,slhull,mdringler,sljackson,ccparker,
thenry,rdowling,jslong,mhjames,lndavis,jdscott,jfu llem,alwrinch" Then
ActiveCell.Offset(0, 6) = "YES"
Else: ActiveCell.Offset(0, 6) = "NO"
End If

ActiveCell.Offset(1, 0).Select

Next c
Loop
End Sub

Also how can I get this to start at the end of another comand that is started
with ctrl + g. ?

TIA

Rebekah

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

--

Dave Peterson

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

Also how can I get this to start at the end of another comand that is started
with ctrl + g. ?

If that command is in the form of a sub and is in the standard module then
put this sub name just before End Sub like the example below:
Sub CtrlG()
'Do stuff
AutoFillIn
End Sub

"RebekahK20_pontiac via OfficeKB.com" wrote:

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




Function UserNameWindows() As String
UserNameWindows = Environ("USERNAME")
End Function



Sub AutoFillIn()
Dim c As Range
Do Until ActiveCell = ""


For Each c In Range("A8", "A1000")

ActiveCell.Offset(0, 8) = "=UserNameWindows()"

If "USERNAME" = "dadunlap,slhull,mdringler,sljackson,ccparker,
thenry,rdowling,jslong,mhjames,lndavis,jdscott,jfu llem,alwrinch" Then
ActiveCell.Offset(0, 6) = "YES"
Else: ActiveCell.Offset(0, 6) = "NO"
End If

ActiveCell.Offset(1, 0).Select

Next c
Loop
End Sub


Also how can I get this to start at the end of another comand that is started
with ctrl + g. ?

TIA

Rebekah

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

OK Dave,
This was working but since I added it to the end of the ctrl g sub, it now
returns a #Name? in the cell....
I need it to return the username no matter what...
TIA... Maybe it's just friday so I'm not sure what I did...

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

THANK you so much.... I guess the obvious tends to be illusive...

JLGWhiz wrote:
Also how can I get this to start at the end of another comand that is started
with ctrl + g. ?

If that command is in the form of a sub and is in the standard module then
put this sub name just before End Sub like the example below:
Sub CtrlG()
'Do stuff
AutoFillIn
End Sub

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

[quoted text clipped - 30 lines]

Rebekah

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

Never mind.. must have been having a blonde moment... i had it in 2 times....

THANKS!!!!!

RebekahK20_pontiac wrote:
OK Dave,
This was working but since I added it to the end of the ctrl g sub, it now
returns a #Name? in the cell....
I need it to return the username no matter what...
TIA... Maybe it's just friday so I'm not sure what I did...

I'd try:
Option Explicit
[quoted text clipped - 35 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