macro help

[T.C]

Hello all,

With help from Dave yesterday, I was able to make the macro work for the
most part. However there's a couple of things that needs to be incorporated.
I would appreciate any help I can get. Many thanks in advance.

Sheet 3 is now showing the login info as following

Date & Time of last login User ID Status Cell changed
Oct 07, 2009 13:56:20 mXXXX Closed M1
Oct 07, 2009 14:04:54 mXXXX Open M2

Sheet 3 is taking the change info (Ex. Status and Cell changed) from sheet 2
because that is where I have all my data.

The thing I would like to incorporate in the macro is to show the Source
name (Ex. B&W, DTE etc) which is column B and Item#(Ex. Fuel Cell Casks -
5729, Gypsum Dewatering- 3982 and so on) which is in column C of sheet 2
along with the status and relevant cell info, anytime there is any change in
the status in that row.
I would like the info on sheet 3 to look like this,
Date & Time of last login User ID Source name Item # Status C
ell changed
Oct 07, 2009 13:56:20 eXXXX B&W FCC-5729 Closed
M1
Oct 07, 2009 14:04:54 eXXXX DTE GDW-3982 Open
M2


So far the macro in sheet 2 looks like this,

Option Explicit
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function


Private Sub Worksheet_Change(ByVal Target As Range)

Dim myCell As Range
Dim myIntersect As Range
Dim DestCell As Range
Dim myAddresses As Variant
Dim aCtr As Long 'address counter
Dim oCol As Long

myAddresses = Array("A:A", "B:B", "C:C", "M:M")

oCol = -14 'It'll start with 1 when 4 is added!
For aCtr = LBound(myAddresses) To UBound(myAddresses)
'using 4 columns per cell change
'1-4, 5-8, 9-12, ...
oCol = oCol + 4
Set myIntersect = Intersect(Target, Me.Range(myAddresses(aCtr)))
If myIntersect Is Nothing Then
'not in that column, do nothing
Else
For Each myCell In myIntersect.Cells
With Sheet3
Set DestCell _
= .Cells(.Rows.Count, oCol).End(xlUp).Offset(1, 0)
With DestCell
.NumberFormat = "mmm dd, yyyy hh:mm:ss"
.Value = Now
.Offset(0, 1).Value = fOSUserName
With .Offset(0, 2)
.NumberFormat = myCell.NumberFormat
.Value = myCell.Value
End With
.Offset(0, 3).Value = myCell.Address(0, 0)
End With
End With
Next myCell
End If
Next aCtr

End Sub


And the code in Thisworkbook is as follows,

Option Explicit

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

thanks,
Tina

 

[Dave Peterson]

First, you only need one version of this code. And it belongs in a general
module--not behind a worksheet and not behind ThisWorkbook:

Option Explicit
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function

Inside the vbe:
Insert|Module
and put the code there (and delete the other two copies)

Second, you can use something like this:

With Sheet3
Set DestCell _
= .Cells(.Rows.Count, oCol).End(xlUp).Offset(1, 0)
With DestCell
.NumberFormat = "mmm dd, yyyy hh:mm:ss"
.Value = Now
.Offset(0, 1).Value = fOSUserName
With .Offset(0, 2)
.NumberFormat = myCell.NumberFormat
.Value = myCell.Value
End With
.offset(0,3).value = sheet2.cells(mycell.row,"B").value
.offset(0,4).value = sheet2.cells(mycell.row,"C").value
.Offset(0, 5).Value = myCell.Address(0, 0)
End With
...

Since you've changed the number of items you're tracking, you'll have to fiddle
with the initial value of oCol. (I don't see why it changed to -14 in your
post.)

ocol = -4 'since we're tracking 5 items
....
and the
ocol = ocol + 5

=======
You could add a variable to do the work for you. Then you only have one thing
to change if you change the layout again.

Dim HowManyItemsAreTracked as long
.....

Howmanyitemsaretracked = 5

Then the initial value would be:
ocol = 1 - howmanyitemsaretracked
and the increment would be
ocol = ocol + howmanyitemsaretracked

Then just fix the assignment if you add/delete more stuff (along with the actual
data, too!).

 

[T.C]

Thanks Dave, you have been immensely helpful! I really appreciate all your
help.

take care,
Tina