PDA

View Full Version : Call code when text is in a Range, NOT every time it appears in the Range.



cchart
10-21-2017, 08:39 PM
Good Evening I am trying to call a code when a value appears in a column. I am trying the code below, but it works every time the value appears. I just want to call the code once if, say "4W" appears in the column. "4W" may appear multiple times in the column. Is there some way to return a True or False maybe to call the code? Thank you!

Sub Main()
Dim wb1 As Worksheet
Set wb1 = Sheets("Sheet1")
With wb1
For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row


If .Cells(i, 2).Value = "4W" Then
Call TimeStampWest
ElseIf .Cells(i, 2).Value = "4E" Then
Call TimeStampEast
ElseIf .Cells(i, 2).Value = "CCU" Then
Call TimeStampCCU

End If


Next
End With

End Sub

Kenneth Hobs
10-21-2017, 09:11 PM
That would normally be done as a sheet change event. I am not sure why you put it in ThisWorkbook and not a Module.

Sub Main()
Dim wb1 As Worksheet, i As Long, r As Range
Set wb1 = Sheets("Sheet1")
With wb1
Set r = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
Select Case .Cells(i, 2).Value
Case "4W"
If WorksheetFunction.CountIf(r, "4W") = 1 Then TimeStampWest
Case "4E"
If WorksheetFunction.CountIf(r, "4E") = 1 Then TimeStampEast
Case "CCU"
If WorksheetFunction.CountIf(r, "CCU") = 1 Then TimeStampCCU
Case Else
End Select
NextI:
Next i
End With
End Sub

cchart
10-22-2017, 12:26 AM
Thank you, Kenneth, for your help! I've only been working with VBA for 2 months so that is why it is not under a change sheet event. I am not sure the real difference between a normal Module and ThisWorkbook. I guess I can put this code in a Module and call it from a change sheet event written in ThisWorkbook. Your code seems to work only if there is one instance of 4W, 4E, or CCU in column 2. If I add more than one instance of 4W, 4E, or CCU that part of the code does not run. I used message boxes to test it as it was quicker than running my TimeStamp codes see below. By the way when the code works a lady at the office from Miami OK will be very happy. Thank you again for your help.

Sub Main1()
Dim wb1 As Worksheet, i As Long, r As Range
Set wb1 = Sheets("Sheet1")
With wb1
Set r = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
Select Case .Cells(i, 2).Value
Case "4W"
If WorksheetFunction.CountIf(r, "4W") = 1 Then MsgBox "Test4W"
Case "4E"
If WorksheetFunction.CountIf(r, "4E") = 1 Then MsgBox "Test4E"
Case "CCU"
If WorksheetFunction.CountIf(r, "CCU") = 1 Then MsgBox "TestCCU"
Case Else
End Select
NextI:
Next i
End With

End Sub

Kenneth Hobs
10-22-2017, 08:08 AM
Please paste code between code tags. Click the # icon on toolbar to insert them. It should maintain your structure but it didn't do so well for mine. I use 2 spaces for indents. Most of the time, it does a fair job. It does join the 2nd line with the 1st so I "usually" edit the reply to fix that.

Sorry, I read your post as if you wanted to only call the other routine once.

Right click the sheet's tab, View Code, and paste:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, calc As Integer

If Target.Count <> 1 Then Exit Sub
Set r = Intersect(Target, Range("B2", Cells(Rows.Count, "B").End(xlUp)))
If r Is Nothing Then Exit Sub


On Error GoTo EndSub
Application.ScreenUpdating = False
Application.EnableEvents = False
calc = Application.Calculation
Application.Calculation = xlCalculationManual


Select Case r.Value
Case "4W"
TimeStampWest
Case "4E"
TimeStampEast
Case "CCU"
TimeStampCCU
Case Else
End Select

EndSub:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = calc
End Sub

cchart
10-22-2017, 08:50 AM
I do only want to call the other routines once. When I ran your original code it would only work if there is one instance of 4W, one 4E, and one CCU, etc in column 2. If there was more than one 4W, 4E or CCU in column 2, the code would not work for me. Thank you for your time, I will have to run this later today, as I have to get household ready for Mass. And, thank you for advice on how to post code in the forum.

Kenneth Hobs
10-22-2017, 09:15 AM
You lost me.

Maybe you want to run a routine to fix things or update things that should have been done already? e.g. Iterate column B values and run the routine for each case's 1st occurrence.

For new data, that is what Change event would do if you add the CountIf() routine to it as in post #2.

It is not uncommon to need a routine to fix things and then use event code to keep data up to date.

cchart
10-22-2017, 11:30 PM
I apologize for losing you. For the code in Post 2, if column B is exactly like below it runs well.

Column B

4E
4W
CCU

But if there is more than one instance of 4E, 4W, or CCU, for example:

Column B

4E
4E
4W
4W
4W
CCU
CCU
CCU
CCU

The code in Post 2 does not work at all.
The code that I originally posted (for the example above) would call 4E twice, 4W three times, and CCU four times.
4W or 4E may appear 25 times in Column B. I only want to call the code once if it appears in column B.

I made a spreadsheet at work which contains (or contained) sensitive information, this is why the abbreviated submission. The spreadsheet at work has a change sheet event if anything is pasted into it, then runs multiple codes to disseminate information to multiple different spreadsheets on a server. The pasted information changes daily, and is not saved into the spreadsheet and the process is repeated daily by multiple users. Not all users need all of the codes to run. Three of the codes are included in the original submission 4E, 4W, and CCU. Using 4W as an example, if it appears in Column B at all (it doesn't matter one or a hundred times), I would like to run the code once.

Kenneth Hobs
10-23-2017, 08:03 AM
Here is the 3rd solution. Ideally, as I explained in post #6, once the data is "fixed" up, you can use the Change event to add stamps as 1st is created. Just add the Countif part to each case as in post #2. It just depends on your needs.

Here, I used the range find method to find the first. I passed the found range to the called Sub in the Application.Run. You probably don't need that so remove the passed parameter and the test stamp subs that I added. You may need to modify the 2nd dimension value for the stamp subs in the array if in another Module.


Sub GetMeSetup()
Dim r As Range, f As Range, a, i As Integer

With Sheet1
Set r = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
End With

ReDim a(1 To 2, 1 To 3)
a(1, 1) = "4W": a(2, 1) = "TimeStampWest"
a(1, 2) = "4E": a(2, 2) = "TimeStampEast"
a(1, 3) = "CCU": a(2, 3) = "TimeStampCCU"
For i = 1 To UBound(a, 2)
Set f = r.Find(a(1, i), r(r.Cells.Count))
If Not f Is Nothing Then Application.Run a(2, i), f
Next i
End Sub


Sub TimeStampWest(ar As Range)
ar.Offset(, 1).Value = "W " & Date
End Sub


Sub TimeStampEast(ar As Range)
ar.Offset(, 1).Value = "E " & Date
End Sub


Sub TimeStampCCU(ar As Range)
ar.Offset(, 1).Value = "C " & Date
End Sub

NoSparks
10-23-2017, 06:46 PM
@ cchart
Are you after the same thing here as you were at MrE (https://www.mrexcel.com/forum/excel-questions/1028086-vba-call-code-if-value-range-not-every-time-range.html) ?

cchart
10-25-2017, 04:53 AM
Thank you Kenneth, I'm going to have to work on this to understand it (I really have only been working with VBA for two months). I did find a solution using worksheetfunction.match, but your holistic solution seems to incapsulate everything I am trying to do, not just what I originally asked for. Thank you for all of your help!