Help with small code addition

[Ironman]

Hi

Book1
	A	B	C	D	E	F	G	H	I
8674	Sun, 19 Sep 2021	OTHER				118	73%	J	Indoor bike session, 60 mins.
8675							#NUM!
Training Log

Cell Formulas
Range	Formula
G8674:G8675	G8674	=F8674/(220-(DATEDIF($G$7,A8674,"Y")))

Named Ranges
Name	Refers To	Cells
LastLogDate	=OFFSET('Training Log'!$A$11,'Training Log'!$B$10,0)	G8674
LastRunDate	=OFFSET('Training Log'!$A$11,'Training Log'!$B$10,0)	G8674
Log_LastDate	=INDEX('Training Log'!All_Log_Dates,ROWS('Training Log'!All_Log_Dates))	G8674

The below code from the above extract should be pretty clear

  Sub FillEndRowBlue()
  Dim NextRow As Long
 
  If ActiveSheet.Name = "Training Log" Then
    NextRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & NextRow).Resize(, 7).Interior.Color = RGB(197, 217, 241)
    Range("I" & NextRow).Resize(, 2).Interior.Color = RGB(197, 217, 241)
    Range("I" & NextRow).Value = "Indoor bike session, 60 mins."
    Range("A" & NextRow).Select








    Range("F" & NextRow).Select
    MsgBox "Enter heart rate", vbInformation, "Data input"
  Else
    MsgBox "Cell fill does not work in this sheet", vbInformation, "Information"
  End If
 
End Sub

I'm just needing a small bit of code to fill in the above (exaggerated) gap so:

1) when data (the date) is input in Col A then Col B is selected.
2) when data (the word 'OTHER') is input in Col B then Col F is selected.

Many thanks!

 

[Gokhan Aycan]

In the sheet's module, under Worksheet_Change event:

If Not Intersect(Target, Columns("A:A")) is Nothing Then
If Target.Value <> "" Then Cells(Target.Row,"B").Select ' To make sure if you delete column A, B won't be selected, otherwise select B
End If

If Not Intersect(Target, Columns("B:B")) is Nothing Then
If UCase(Target.Value) = "OTHER" Then Cells(Target.Row,"F").Select
End If

 

[Ironman]

Many thanks Gokhan - I'm wary of using the Worksheet_Change event for that sheet as the Change event already contains a fair amount of code and it might conflict with what else is happening.

If the code in my first post works without needing to make use of the Worksheet_Change event, I'm hoping it can still be avoided?

 

[Gokhan Aycan]

Modifying your code will work if:

If there is data in Column A then ...
If there is "OTHER" in Column B then...

But that doesn't help at all, since you want to select a cell.

Change event is the only way, if you want something to happen when data is input as far as I know. If you are already using the change event, and checking if the target range is what you want (using Intersect), there shouldn't be any conflicts. Or even if there is, it should be fixable.

Do you happen to call the above macro from change event?

 

[Ironman]

The above was provided for use in a workbook module and isn't related to a change event. The original code had this line

With Intersect(Rows(Cells(Rows.Count, 1).End(xlUp).Row + 1), Union(Columns("A:G"), Columns("I:J")))

(the columns have changed slightly since).
I don't know if using something similar would avoid using a change event?

 

[Ironman]

I've got a similar macro that IS in a worksheet_change event in another sheet (courtesy of NoSparks) but I don't know how to adapt this to the above question - maybe you can adapt this?

Private Sub Worksheet_Change(ByVal target As Range)
Dim NextRow As Long

lr = Range("A" & Rows.Count).End(xlUp).Row

If target.Address(0, 0) = Range("A" & Rows.Count).End(xlUp).Address(0, 0) Then
    Application.EnableEvents = False
    Range("B" & target.Row).Value = "1:00:00"
    Range("E" & target.Row).Value = "8"
    Range("J" & target.Row).Value = "Session "
    Range("C" & target.Row).Select 'move to this cell to start inputting data

    MsgBox "Enter distance", vbInformation, "Data input"
End If
Application.EnableEvents = True
' jump from C to F on that same row
If target.Address(0, 0) = Range("C" & lr).Address(0, 0) Then
    Range("F" & lr).Select
    MsgBox "Enter heart rate", vbInformation, "Data input"
End If
' jump from F to H on that same row
If target.Address(0, 0) = Range("F" & lr).Address(0, 0) Then
    Range("H" & lr).Select
End If

 

[Ironman]

I've managed to make it run in the worksheet_change event

Dim NextRow As Long
Application.EnableEvents = False
lr = Range("A" & Rows.Count).End(xlUp).Row
If target.Address(0, 0) = Range("B" & lr).Address(0, 0) Then
    Range("F" & lr).Select
    MsgBox "Enter heart rate", vbInformation, "Indoor Bike Session Data"
Application.EnableEvents = True
End If

However, I can't use it as it conflicts with a module that uses the same row in the same sheet and the output from the module is trying to combine both macros...

If anyone can figure out what I need to add to the code below to stop the above code interfering then I'll buy them a pint in an English pub

Dim NewRunDate As Date
Dim NextAvailableRow As Long
Dim LogWks As Worksheet
Dim RateMe As Variant
Dim NewRouteData As Variant
Dim newdist As Double
Set LogWks = Sheets("Training Log")
  With LogWks
    NextAvailableRow = Range("A23357").End(xlUp).Row + 1
  End With
  
 Cells(NextAvailableRow, 1) = DateValue(RunDate)

For r = 0 To RouteDetail.ListCount - 1
Z = RouteDetail.ListCount
If RouteDetail.Selected(r) Then
X = RouteDetail.ListIndex
   If X > 0 Then
      Cells(NextAvailableRow, 2) = Sheets("Routes").Cells(X + 2, 2).Text & "     (" & _
        Sheets("Routes").Cells(X + 2, 5) & ")"
        Sheets("Routes").Cells(X + 2, 6) = CommentsBox.Text
 
   End If
     If X = 0 Then
       Cells(NextAvailableRow, 2) = Sheets("Routes").Cells(Z + 2, 2).Text & "    (" & _
        Sheets("Routes").Cells(Z + 2, 5) & ")"
        Sheets("Routes").Cells(Z + 2, 6) = CommentsBox.Text
        Sheets("Routes").Cells(Z + 2, 5) = NewDay & "/" & Newmonth & "/" & NewYear
        
     End If
End If
Next r

Cells(NextAvailableRow, 3) = Mileage.Value
If TimeHour.Value = "" Then TimeHour.Value = 0
Cells(NextAvailableRow, 4) = (TimeHour.Value & ":" & TimeMinute.Value & ":" & TimeSecond.Value)
Cells(NextAvailableRow, 5).Formula = "=D" & NextAvailableRow & "/C" & NextAvailableRow
Cells(NextAvailableRow, 6) = HeartRateAve.Value '01.2019 changed to Heart Rate (BPM)

If Good.Visible = True Then
Cells(NextAvailableRow, 8).Activate '="Wingdings J"
Call FillGreen

End If

If Poor.Visible = True Then
Cells(NextAvailableRow, 8).Activate '="Wingdings L"
Call FillRed
End If

If Warning.Visible = True Then
Cells(NextAvailableRow, 8).Activate '="Wingdings K"
Call FillAmber
End If

Cells(NextAvailableRow, 9) = CommentsBox.Text

 

[Gokhan Aycan]

If you don't want some code to trigger events then at the beginning of that section:

Application.EnableEvents = False

and after that section:

Application.EnableEvents = True

 

[Ironman]

Many thanks Gokhan!