Help with small code addition

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
Hi

Book1
ABCDEFGHI
8674Sun, 19 Sep 2021OTHER11873%JIndoor bike session, 60 mins.
8675#NUM!
Training Log
Cell Formulas
RangeFormula
G8674:G8675G8674=F8674/(220-(DATEDIF($G$7,A8674,"Y")))
Named Ranges
NameRefers ToCells
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
VBA Code:
  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!
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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
 
Upvote 0
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?
 
Upvote 0
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?
 
Upvote 0
The above was provided for use in a workbook module and isn't related to a change event. The original code had this line
VBA Code:
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?
 
Upvote 0
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?
VBA Code:
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
 
Upvote 0
I've managed to make it run in the worksheet_change event
VBA Code:
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 :)
VBA Code:
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
 
Upvote 0
If you don't want some code to trigger events then at the beginning of that section:

VBA Code:
Application.EnableEvents = False

and after that section:

VBA Code:
Application.EnableEvents = True
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top