Look for last column that has a specific value

A

alisoncleverly

New Member
Joined
Feb 20, 2020
Messages
28
Office Version
  1. 2013
Platform
  1. Windows
Hi everyone,

I tried the following code to do: If any Sales cells have "Title Transfer" then the 51st column would have an "x".

I have 8 columns named "Sales" in total. The 5st column is named "Title Transfer".

VBA Code: 
Option Explicit
Public Const colTTransfer As Long = 51

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lastColumn As Long
Dim counter As Long

lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column

    If Me.Cells(1, Target.Column).Value = "Sales" Then

        For counter = 1 To lastColumn

            If Me.Cells(Target.Row, counter).Value = "Title Transfer" Then

            Me.Cells(Target.Row, colTTransfer).Value = "x"

            End If

        Next counter

    End If

End Sub

However, I realised there was more to my original purpose and the above codes weren't flexible.
I'm wondering if there is a way to only return "x" for the last Sales column that has "Title Transfer"?

For example, assuming these events happen in the same row where:

1st Sales column has Green and 51st column remain blank
2nd Sales column has Title Transfer and 51st column has x
3rd Sales column has Rollup and 51st column turns blank
4th Sales column has Red and 51st column remains the same
5th Sales column has Title Transfer and 51st column now has x and so on

FYI:
1st Sales column is column N
2nd Sales column is column R
3rd Sales column is column V
4th Sales column is column Z
5th Sales column is column AD
6th Sales column is column AH
7th Sales column is column AL
8th Sales column is column AP

Really sorry that I couldn't include a sample here since my work laptop doesn't allow me to download any add-in, including XL2BB.

Please advise how I can make it work that way. Any help is highly appreciated! Thanks a lot!
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
Check if this is what you need.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
    
    Dim MaxCol As Variant, r As Range
    
    Set r = Range("N" & Target.Row & ":AP" & Target.Row)
    MaxCol = Evaluate("=MAX(IF(" & r.Address & "<>"""",COLUMN(" & r.Address & ")))")
    If MaxCol Mod 4 = 2 Then
      If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
        Cells(Target.Row, 51).Value = "x"
      Else
        Cells(Target.Row, 51).Value = ""
      End If
    End If
    
  End If
End Sub
 
Upvote 0
Hi
DanteAmor said:
Check if this is what you need.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
   
    Dim MaxCol As Variant, r As Range
   
    Set r = Range("N" & Target.Row & ":AP" & Target.Row)
    MaxCol = Evaluate("=MAX(IF(" & r.Address & "<>"""",COLUMN(" & r.Address & ")))")
    If MaxCol Mod 4 = 2 Then
      If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
        Cells(Target.Row, 51).Value = "x"
      Else
        Cells(Target.Row, 51).Value = ""
      End If
    End If
   
  End If
End Sub
Click to expand...

Hi DanteAmor, thanks a lot for the codes, however, they didn't seem to work in my case.

Here is the link to my sample file. The codes should be in "Master Worksheet"
sample file

I'm not sure why it's not working when I added the codes. For example, when I put "Title Transfer" in a random Sales cell, the 51st would still remain blank
 
Upvote 0
alisoncleverly said:
I'm wondering if there is a way to only return "x" for the last Sales column that has "Title Transfer"?
Click to expand...

So I did not understand that part

alisoncleverly said:
when I put "Title Transfer" in a random Sales cell,
Click to expand...

Maybe you just need this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
    
    If Target.Value = "Title Transfer" Then
      Cells(Target.Row, 51).Value = "x"
    Else
      Cells(Target.Row, 51).Value = ""
    End If
    
  End If
End Sub
 
Upvote 0
DanteAmor said:
So I did not understand that part



Maybe you just need this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
   
    If Target.Value = "Title Transfer" Then
      Cells(Target.Row, 51).Value = "x"
    Else
      Cells(Target.Row, 51).Value = ""
    End If
   
  End If
End Sub
Click to expand...
Hi Dante, very sorry that I confused you and thanks again for the codes. Still, didn't work out, the "x" never appeared in 51st column and the processing time took very long.

As you can see, I have many "Sales" columns. So essentially, I wanted the codes to look for the LAST "Sales" column with "Title Transfer". In other words, every time a Sales cell gets updated, that cell needs to be compared to all Sales cells in precedent Sales columns to see if it's the last Sales with "Title Transfer".

Let's say, I entered "Title Transfer" in 2nd Sales column, 51st column will have an "x".
However, if I entered "Green" or any values different from "Title Transfer" in 3rd Sales column, 51st column will become blank because the value isn't "Title Transfer".
And again, if "Title Transfer" in 4th Sales column, an "x" will reappear in 51st column.

I really appreciate your help so far. Please let me know if anything is still not clear to you. Thank you very much
 
Upvote 0
alisoncleverly said:
Let's say, I entered "Title Transfer" in 2nd Sales column, 51st column will have an "x".
Click to expand...

That makes the macro of post #2.
But you must enter the texts in these columns:
1st Sales column is column N
2nd Sales column is column R
3rd Sales column is column V
4th Sales column is column Z
5th Sales column is column AD
6th Sales column is column AH
7th Sales column is column AL
8th Sales column is column AP

And the text entered must be written exactly like this: "Title Transfer" (upper and lower case)
 
Upvote 0
DanteAmor said:
That makes the macro of post #2.
But you must enter the texts in these columns:
1st Sales column is column N
2nd Sales column is column R
3rd Sales column is column V
4th Sales column is column Z
5th Sales column is column AD
6th Sales column is column AH
7th Sales column is column AL
8th Sales column is column AP

And the text entered must be written exactly like this: "Title Transfer" (upper and lower case)
Click to expand...
Hi Dante, I put your codes in a different workbook with only relevant data. They worked perfectly, however, when I put them back to my workbook, it stopped working. So I guess it was because of my codes.

VBA Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, r1 As Range
   
    Dim lastColumn As Long
    Dim counter As Long
   
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales1).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales2).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales3).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)
   
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales4).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales5).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales6).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)
   
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales7).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales8).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)
   
    ' Get last column based on first row
    lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
   
    If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then
        For counter = 1 To lastColumn
            If (Me.Cells(1, counter).Value = "Sales" Or Me.Cells(1, counter).Value = "Production") And IsEmpty(Me.Cells(Target.Row, counter).Value) Then
            Me.Cells(Target.Row, counter).Value = "Rollup"
            End If
        Next counter
    ElseIf Me.Cells(1, Target.Column).Value = "Sales" Then
        For counter = 1 To lastColumn
            If Me.Cells(Target.Row, counter).Value = "Title Transfer" Then
            Me.Cells(Target.Row, colTTransfer).Value = "x"
            End If
        Next counter
    End If
End Sub

Private Sub DoCells(r As Range)
    Dim r1 As Range
    For Each r1 In r.Cells
        With r1
            Select Case .Column
                Case colSales1, colSales2, colSales3, colSales4, colSales5, colSales6, colSales7, colSales8
                    Call MasterChange(.Resize(1, 3))
                Case colProduction1, colProduction2, colProduction3, colProduction4, colProduction5, colProduction6, colProduction7, colProduction8
                    Call MasterChange(.Offset(0, -1).Resize(1, 3))
                Case colDay1, colDay2, colDay3, colDay4, colDay5, colDay6, colDay7, colDay8
                    Call MasterChange(.Offset(0, -2).Resize(1, 3))
            End Select
        End With
    Next
End Sub

Above is what I currently have in my "Master Worksheet" (without your codes)

And this is in the Module:
VBA Code: 
Option Explicit

Public Const colSales1 As Long = 14
Public Const colProduction1 As Long = 15
Public Const colDay1 As Long = 16
Public Const colStatus1 As Long = 17

Public Const colSales2 As Long = 18
Public Const colProduction2 As Long = 19
Public Const colDay2 As Long = 20
Public Const colStatus2 As Long = 21

Public Const colSales3 As Long = 22
Public Const colProduction3 As Long = 23
Public Const colDay3 As Long = 24
Public Const colStatus3 As Long = 25

Public Const colSales4 As Long = 26
Public Const colProduction4 As Long = 27
Public Const colDay4 As Long = 28
Public Const colStatus4 As Long = 29

Public Const colSales5 As Long = 30
Public Const colProduction5 As Long = 31
Public Const colDay5 As Long = 32
Public Const colStatus5 As Long = 33

Public Const colSales6 As Long = 34
Public Const colProduction6 As Long = 35
Public Const colDay6 As Long = 36
Public Const colStatus6 As Long = 37

Public Const colSales7 As Long = 38
Public Const colProduction7 As Long = 39
Public Const colDay7 As Long = 40
Public Const colStatus7 As Long = 41

Public Const colSales8 As Long = 42
Public Const colProduction8 As Long = 43
Public Const colDay8 As Long = 44
Public Const colStatus8 As Long = 45

Public Const colStatus9 As Long = 46

Public Const colTTransfer As Long = 51

Public Sub MasterChange(SPD As Range)
    Dim rSales As Range
    Dim rProduction As Range
    Dim rDay As Range
   
    Set rSales = SPD.Cells(1, 1)
    Set rProduction = SPD.Cells(1, 2)
    Set rDay = SPD.Cells(1, 3)
   
    Application.EnableEvents = False
    If rSales = "Rollup" And rProduction = "Rollup" Then
        rDay = "Rollup"
    ElseIf rSales = "Rollup" And rProduction = "Green" Then
        rDay = "Green"
    ElseIf rSales = "Title Transfer" And rProduction = "Overdue" Then
        rDay = "Overdue"
    ElseIf rSales = "Title Transfer" And IsEmpty(rProduction) Then
        rDay = "Title Transfer"
    ElseIf rSales = " " And rProduction = " " Then
        rDay.ClearContents
    End If
    Application.EnableEvents = True
End Sub

Can you please advise how to incorporate your codes so that they work with mine? And thank you very much! The codes are awesome
 
Upvote 0
Try this

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, r1 As Range, lastColumn As Long, counter As Long
  Dim MaxCol As Variant, rg As Range
   
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(Target.Column).Resize(, 3))
    Call DoCells(r)
  End If
  
  ' Get last column based on first row
  lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
  If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then
    For counter = 1 To lastColumn
      If (Me.Cells(1, counter).Value = "Sales" Or Me.Cells(1, counter).Value = "Production") And IsEmpty(Me.Cells(Target.Row, counter).Value) Then
        Me.Cells(Target.Row, counter).Value = "Rollup"
      End If
    Next counter
  End If
   
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
    Set rg = Range("N" & Target.Row & ":AP" & Target.Row)
    MaxCol = Evaluate("=MAX(IF(" & rg.Address & "<>"""",COLUMN(" & rg.Address & ")))")
    If MaxCol Mod 4 = 2 Then
      If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
        Cells(Target.Row, 51).Value = "x"
      Else
        Cells(Target.Row, 51).Value = ""
      End If
    End If
  End If
End Sub
 
Upvote 0
DanteAmor said:
Try this

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, r1 As Range, lastColumn As Long, counter As Long
  Dim MaxCol As Variant, rg As Range
  
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(Target.Column).Resize(, 3))
    Call DoCells(r)
  End If
 
  ' Get last column based on first row
  lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
  If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then
    For counter = 1 To lastColumn
      If (Me.Cells(1, counter).Value = "Sales" Or Me.Cells(1, counter).Value = "Production") And IsEmpty(Me.Cells(Target.Row, counter).Value) Then
        Me.Cells(Target.Row, counter).Value = "Rollup"
      End If
    Next counter
  End If
  
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
    Set rg = Range("N" & Target.Row & ":AP" & Target.Row)
    MaxCol = Evaluate("=MAX(IF(" & rg.Address & "<>"""",COLUMN(" & rg.Address & ")))")
    If MaxCol Mod 4 = 2 Then
      If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
        Cells(Target.Row, 51).Value = "x"
      Else
        Cells(Target.Row, 51).Value = ""
      End If
    End If
  End If
End Sub
Click to expand...

I really don't know what's going on with my file. When I put your codes in an entirely new file, they worked like charms. However, even using the most updated codes you just wrote, the result only worked in my 8th Sales column. I put "Title Transfer" in the other Sales columns but no effect.

Technically speaking, the 8th sales column is my last Sales column but again it's not quite the context I want.

Thansk very much for your help so far! :)
 
Upvote 0
DanteAmor said:
Try this

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, r1 As Range, lastColumn As Long, counter As Long
  Dim MaxCol As Variant, rg As Range
  
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(Target.Column).Resize(, 3))
    Call DoCells(r)
  End If
 
  ' Get last column based on first row
  lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
  If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then
    For counter = 1 To lastColumn
      If (Me.Cells(1, counter).Value = "Sales" Or Me.Cells(1, counter).Value = "Production") And IsEmpty(Me.Cells(Target.Row, counter).Value) Then
        Me.Cells(Target.Row, counter).Value = "Rollup"
      End If
    Next counter
  End If
  
  If Not Intersect(Target, Range("N:AP")) Is Nothing And Target.Column Mod 4 = 2 Then
    If Target.CountLarge > 1 Then Exit Sub
    Set rg = Range("N" & Target.Row & ":AP" & Target.Row)
    MaxCol = Evaluate("=MAX(IF(" & rg.Address & "<>"""",COLUMN(" & rg.Address & ")))")
    If MaxCol Mod 4 = 2 Then
      If Cells(Target.Row, MaxCol).Value = "Title Transfer" Then
        Cells(Target.Row, 51).Value = "x"
      Else
        Cells(Target.Row, 51).Value = ""
      End If
    End If
  End If
End Sub
Click to expand...

I really don't know what's going on with my file. When I put your codes in an entirely new file, they worked like charms. However, even using the most updated codes you just wrote, the result only worked in my 8th Sales column. I put "Title Transfer" in the other Sales columns but no effect.

Technically speaking, the 8th sales column is my last Sales column but again it's not quite the context I want.

Thansk very much for your help so far! :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Moving rows to different sheets based on drop down.
2
Replies
12
Views
1K
purevega
P
G
  • Question Question
Convert formula to value in a table column using VBA
Replies
7
Views
1K
gsinkinson
G
I
  • Solved
Two values on userform but only send one value to worksheet
Replies
5
Views
253
ipbr21054
I
V
  • Question Question
Find given value and returns the highest sale number, column reference
Replies
2
Views
449
vladi305
V
K
  • Question Question
Lottery Combinations Filter
Replies
2
Views
1K
Fluff
Fluff

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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