Worksheet_Change Auto Pop 1

[tweek312]

I have this code which used to pop the systime into a specific cell based on a condition. Formerly I only had two or three cases on this code and it worked perfectly for what I needed. Now I would like to modify the code to pop the word "PENDING" into a specific cell when anything inside a "Range" is changed. I have jurry-rigged it to work similarly to the way I want but its not quite right. The range in this instance is L4:AB4 to L153:AB153. Each row must operate independently and the "hook" for the entry of the word "PENDING" should be if the range contains one or more "x"s. If it matters I could use a countif on the side to find the "x"s which I presume could be easier than doing it in VBA.

Thanks,

tW33k

Private Sub Worksheet_Change(ByVal Target As Range)
' this sub adds a timestamp on the row where data was entered
Dim TargetCell As Range
    ' check to see if target cell is in the input portion of the worksheet
For Each TargetCell In Target
    If (TargetCell.Row >= 3) And (TargetCell.Row <= 154) Then
        ' check to see if target column is C, D, or G
        If (TargetCell.Column = 12) _
        Or (TargetCell.Column = 13) _
        Or (TargetCell.Column = 14) _
        Or (TargetCell.Column = 15) _
        Or (TargetCell.Column = 16) _
        Or (TargetCell.Column = 17) _
        Or (TargetCell.Column = 18) _
        Or (TargetCell.Column = 19) _
        Or (TargetCell.Column = 20) _
        Or (TargetCell.Column = 21) _
        Or (TargetCell.Column = 22) _
        Or (TargetCell.Column = 23) _
        Or (TargetCell.Column = 24) _
        Or (TargetCell.Column = 25) _
        Or (TargetCell.Column = 26) _
        Or (TargetCell.Column = 27) _
        Or (TargetCell.Column = 28) Then
            Select Case TargetCell.Column
                Case 12: intTimeCol = 29  ' set timestamp column to B
                Case 13: intTimeCol = 29 ' set timestamp column to B
                Case 14: intTimeCol = 29
                Case 15: intTimeCol = 29
                Case 16: intTimeCol = 29
                Case 17: intTimeCol = 29
                Case 18: intTimeCol = 29
                Case 19: intTimeCol = 29
                Case 20: intTimeCol = 29
                Case 21: intTimeCol = 29
                Case 22: intTimeCol = 29
                Case 23: intTimeCol = 29
                Case 24: intTimeCol = 29
                Case 25: intTimeCol = 29
                Case 26: intTimeCol = 29
                Case 27: intTimeCol = 29
                Case 28: intTimeCol = 29
                
            End Select
            
            If TargetCell.Text <> "" Then   ' check to see if the target cell is empty
                Cells(TargetCell.Row, intTimeCol).Value = "PENDING"  ' add timestamp to target row
            
            Else
                Cells(TargetCell.Row, intTimeCol).Value = ""    ' delete timestamp if target cell is empty

            End If
        End If
    End If
Next

Dim Result As Integer
            Result = Application.WorksheetFunction.CountIf([d_range], "duplicate")
            If Result > 0 Then
            MsgBox "You have created a duplicate item. Please check the duplicate column.", vbExclamation
            End If
            
End Sub

 

[SkipVought]

Hi,

Check this out...

Private Sub Worksheet_Change(ByVal Target As Range)
' this sub adds a timestamp on the row where data was entered
    Dim TargetCell As Range
        ' check to see if target cell is in the input portion of the worksheet
    For Each TargetCell In Target
        If (TargetCell.Row >= 3) And (TargetCell.Row <= 154) Then
            ' check to see if target column is C, D, or G
            Select Case TargetCell.Column
                Case 12 To 28
                    intTimeCol = 29  ' set timestamp column to B
                    If TargetCell.Text <> "" Then   ' check to see if the target cell is empty
                        Cells(TargetCell.Row, intTimeCol).Value = "PENDING"  ' add timestamp to target row
                    
                    Else
                        Cells(TargetCell.Row, intTimeCol).Value = ""    ' delete timestamp if target cell is empty
        
                    End If
            End Select
        End If
        End If
    Next

    Dim Result As Integer
    Result = Application.WorksheetFunction.CountIf([d_range], "duplicate")
    If Result > 0 Then
        MsgBox "You have created a duplicate item. Please check the duplicate column.", vbExclamation
    End If
            
End Sub

Skip,

_{[red]Sign above the facsimile apparatus at the music publisher:[/red]
If it ain't baroque...
Don't FAX it!}

 

[SkipVought]

oops...

forgot to remove an end if

Private Sub Worksheet_Change(ByVal Target As Range)
' this sub adds a timestamp on the row where data was entered
    Dim TargetCell As Range
        ' check to see if target cell is in the input portion of the worksheet
    For Each TargetCell In Target
        If (TargetCell.Row >= 3) And (TargetCell.Row <= 154) Then
            ' check to see if target column is C, D, or G
            Select Case TargetCell.Column
                Case 12 To 28
                    intTimeCol = 29  ' set timestamp column to B
                    If TargetCell.Text <> "" Then   ' check to see if the target cell is empty
                        Cells(TargetCell.Row, intTimeCol).Value = "PENDING"  ' add timestamp to target row
                    
                    Else
                        Cells(TargetCell.Row, intTimeCol).Value = ""    ' delete timestamp if target cell is empty
        
                    End If
            End Select
        End If
    Next

    Dim Result As Integer
    Result = Application.WorksheetFunction.CountIf([d_range], "duplicate")
    If Result > 0 Then
        MsgBox "You have created a duplicate item. Please check the duplicate column.", vbExclamation
    End If
            
End Sub

Skip,

_{[red]Sign above the facsimile apparatus at the music publisher:[/red]
If it ain't baroque...
Don't FAX it!}

 

[tweek312]

Thanks for tidying it up, much easier to read now but I am still having a problem. I didnt really identify the problem originally (my bad) but heres whats happening.

If I have two "X"s in the range A-I and I remove one of them (the X in col C for this example) the pending stamp goes away. Now I know that the code is written to do this but in theory it should also return a new "PENDING" stamp for the remaining X correct? I presume that this is because the code is looking at each cell in the range rather than the entire range as a whole. This is where my problem lies. Here are some visuals.

tx,
tW33k

A|B|C|D|E|F|G|H|I|J_____J|
X   X             PENDING

A|B|C|D|E|F|G|H|I|J_____J|
X

 

[SkipVought]

???

Please state the criteria for what is supposed to happen.

For instance, when a change is made in a row, in what columns, then what gets evaluated and what are the possible results.

Skip,

_{[red]Sign above the facsimile apparatus at the music publisher:[/red]
If it ain't baroque...
Don't FAX it!}

 

[tweek312]

What I would like it to do is the following:

Upon each worksheet_change check if any rows within columns A - I contain the letter "X". If true then populate the word "PENDING" on the row where the "X" resides in column J. For instance... If I were to put an X in B5 then the code would populate the word "PENDING" in J5. I need it to be smart enough to know that if an X still resides in the row (ie. an x was entered on col b and c)that the "PENDING" stays. When and if both Xs are removed the "PENDING" disappears.

I dont know how else to put it...

Thanks,

tW33k

 

[vbap]

I think this will do the trick for you...At least I think its what you're looking for. You have to adjust the routine's CornerCellStart and CornerCellEnd for the desired range under examination.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rowrg As Range
Dim CornerCellStart As Range
Dim CornerCellEnd As Range
Dim TheCell As Object

Set CornerCellStart = Cells(4, 4)
Set CornerCellEnd = Cells(10, 10)

r = Target.Row
c = Target.Column

If (r >= CornerCellStart.Row And r <= CornerCellEnd.Row) And _
(c >= CornerCellStart.Column And c <= CornerCellEnd.Column) Then
Set rowrg = Range(Cells(r, CornerCellStart.Column), Cells(r, CornerCellEnd.Column))
Set TheCell = FindItem(rowrg, "x")
If Not TheCell Is Nothing Then
Cells(TheCell.Row, CornerCellEnd.Column + 1).Value = "Pending"
Else
Cells(r, CornerCellEnd.Column + 1).ClearContents
End If
End If
End Sub

Private Function FindItem(ByRef VarRange As Range, ByVal Var As Variant) As Object
On Local Error GoTo ErrFindItem
Dim c As Object

Set c = VarRange.Find(What:=Var, lookAt:=xlPart)
If Not c Is Nothing Then
Set FindItem = c
Else
Set FindItem = Nothing
End If
Exit Function
ErrFindItem:
Set FindItem = Nothing
End Function

 

[tweek312]

Tried the code and once I redefined the CornerCellStart; and CornerCellEnd; which I set to:

Set CornerCellStart = Cells(4, 12)
Set CornerCellEnd = Cells(153, 28)

The code works with greater ease thats for sure but... One tiny little glitch...

Upon deleting a column of "X"s for example L15:L28 only the topmost "PENDING" stamp is removed, in this case L15 would go away and the pending stamps for rows 16 to 28 would remain. On the plus side when removing a consecutive row of 'X's the stamp stays until the last X is removed...regardless.

Please confirm the format of the Start and End Cells. Does it go by COL, ROW or ROW, COL? I used ROW, COL.

Thanks!

tW33k

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rowrg As Range
    Dim CornerCellStart As Range
    Dim CornerCellEnd As Range
    Dim TheCell As Object
    
    Set CornerCellStart = Cells(4, 12)
    Set CornerCellEnd = Cells(153, 28)
    
    r = Target.Row
    c = Target.Column

    If (r >= CornerCellStart.Row And r <= CornerCellEnd.Row) And _
        (c >= CornerCellStart.Column And c <= CornerCellEnd.Column) Then
            Set rowrg = Range(Cells(r, CornerCellStart.Column), Cells(r, CornerCellEnd.Column))
            Set TheCell = FindItem(rowrg, "x")
            If Not TheCell Is Nothing Then
                Cells(TheCell.Row, CornerCellEnd.Column + 1).Value = "PENDING"
            Else
                Cells(r, CornerCellEnd.Column + 1).ClearContents
            End If
    End If
End Sub

Private Function FindItem(ByRef VarRange As Range, ByVal Var As Variant) As Object
    On Local Error GoTo ErrFindItem
    Dim c As Object
    
    Set c = VarRange.Find(What:=Var, lookAt:=xlPart)
    If Not c Is Nothing Then
        Set FindItem = c
    Else
        Set FindItem = Nothing
    End If
    Exit Function
ErrFindItem:
    Set FindItem = Nothing
End Function

 

[SkipVought]

Whereas you were looping thru each cell in Target, now you are not.

Target is the range of the change. Target would be L15:L28 in your example.

Your code is only dealing with the upper l-h cell in the Target range

Skip,

_{[red]Sign above the facsimile apparatus at the music publisher:[/red]
If it ain't baroque...
Don't FAX it!}

 

[tweek312]

I see...

Well I think that this will do, I was hoping that I could get it to work exactly the way I want but no biggie. This is much better than what I had started with.

Thanks Skip!

tW33k

 

[sfatz]

Of course, now that everyone has explored a VBA solution, is it possible to use a formula, or conditional formatting, in col J to achieve the same thing?
For example, IF(COUNTA(A2:I2)>0,"PENDING","")

 

[tweek312]

That was my initial and preferred method... however. I need the cell to be open for text input. The PENDING is more of a default value that I use as a switch in my reports. Therefore if the cell is blank the report assumes no data. A user must also at any time be able to change the PENDING to a CORRECTED; thus I need a VBA solution rather than a simple formula. It would be great if you could use Conditional Formatting for this sort of thing but unfortunatly, Conditional Formatting is limited to just that... Formatting. DOH!

=D
tW33k

 

[vbap]

The visual you gave above, I thought, was referring to a row with X's in it. So the routine works to show "Pending" for the row as long as there is an X in the row in the given row range. The range you pass to the FindItem function can be a different dimension. In the case above it was a row within the column boundries that are defined by the corner cells of a larger range of cells.

Also "Pending" will remain for any text string in a row cell that contains an "x". Change the xlPart constant to xlWhole if you want it to be for just the character "x" alone.

Yes.. Cells(row,col) is how a corner cell is defined for the routine.

CornerCellStart is top left hand corner of a range of cells and CornerCellEnd is the bottom right hand corner of that same range.

If you want "Pending" to disappear for a column of X's then give the FindItem function a column range of cells instead of a row range of cells.

Looks like I haven't fully understood your criteria for the word "Pending" to disappear. However, it sounds like a little adjustment will get you what you want.

 

[vbap]

Again the range (it can be any two dimensional size) you pass to the FindItem function will look for the character "x" within it. If it finds one the function returns the cell where it was found.

You can put the word "Pending" anywhere you desire. If there is no "x" to be found in the range then clear the contents of the cell where the word "Pending" was...or if you wish you can change the word to something else.