Modify a cell value if two other cells contain certain value

Z

zack8576

Active Member
Joined
Dec 27, 2021
Messages
271
Office Version
  1. 365
Platform
  1. Windows
I need to modify some excel files, if column K contains "AO", "COVER", and column N contains "Tampa"
then any "Riser", "Cone", 'Top slab" (column K) with the same item label (column B) gets the letter J at the end of the value in column D
so in the screenshot below, rows 2 and 3 will be: F14632J and F14824J

I have a partially working code that does exactly this if N contains Tampa, how do I modify my code to have it look for AO COVER in column K ?


1672955363151.png


VBA Code: 
Sub CityOfTampa()
    Dim c As Variant
    For Each c In Range("N2:N" & Cells(Rows.Count, 1).End(3).Row)
        If c Like "*Tampa*" Or _
           c Like "*Tampa*" Then Tampa = c.Offset(, -9)
        For Each d In Range("K2:K" & Cells(Rows.Count, 1).End(3).Row)
            If d Like "*4'*" And d Like "*Riser*" Or _
               d Like "*4'*" And d Like "*Top Slab*" Or _
               d Like "*4'*" And d Like "*Cone*" Or _
               d Like "*5'*" And d Like "*Cone*" Then
                If d.Offset(, 3) Like "*Tampa*" Then
                    If Right(d.Offset(, -7), 1) <> "J" Then
                        d.Offset(, -7) = d.Offset(, -7) & "J"
                    End If
                End If
            End If
        Next d
    Next c
End Sub
 

Attachments

  • 1672954906257.png
    1672954906257.png
    197.5 KB · Views: 15

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Alex Blakenburg said:
Do you have any formulas in column D ?
Also how much data (in rows) do you have ?
Click to expand...
Nope, there is no formula in column D, or in any other cell
the data range from single digit # of rows up to thousands of rows.

I also want to point out, in my code above, the d is defined As Range
this code works fine, it adds J to the end of the value in column D on the relevant rows.
However it does this under just one criteria, I need to add one more criteria: column K needs to contain AO and COVER

Any help is appreciated :)
 
Upvote 0
Give the below a try:
Note:
If you can rely on the phrase "AO COVER" then just use Like "*AO COVER*"
equally if you can rely on the order of the numeric being before the other search term your could simplify to
descr Like "*4'*Riser*"

VBA Code: 
Sub CityOfTampa()

    Dim ws As Worksheet
    Dim rng As Range, arr As Variant
    Dim lastRow As Long, lastCol As Long, i As Long
    Dim descr As String
   
   
    Set ws = ActiveSheet
    With ws
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(2, "A"), .Cells(lastRow, lastCol))
        arr = rng.Value
    End With
   
    Dim dictItemLbl As Object, dictKey As String

    Set dictItemLbl = CreateObject("Scripting.dictionary")
   
    ' Load details range into Dictionary
    For i = 1 To UBound(arr)
        dictKey = arr(i, 2)
        descr = arr(i, 11)
       
        If arr(i, 14) Like "*Tampa*" And descr Like "*AO*" And descr Like "*COVER*" Then
            If Not dictItemLbl.exists(dictKey) Then
                dictItemLbl(dictKey) = i
            End If
        End If
    Next i
   
    ' Get Other rows for selected Items Labels and test for value
    For i = 1 To UBound(arr)
        dictKey = arr(i, 2)
        descr = arr(i, 11)
        If dictItemLbl.exists(dictKey) Then
            If arr(i, 14) Like "*Tampa*" Then               ' Not required if this is always the same for the Item Label
                If descr Like "*4'*" And descr Like "*Riser*" Or _
                    descr Like "*4'*" And descr Like "*Top Slab*" Or _
                    descr Like "*4'*" And descr Like "*Cone*" Or _
                    descr Like "*5'*" And descr Like "*Cone*" Then
                   
                        arr(i, 4) = arr(i, 4) & "J"
                End If

            End If
        End If

    Next i
   
    rng.Columns(4) = Application.Index(arr, 0, 4)
       
End Sub
 
Upvote 0
Solution
Alex Blakenburg said:
Give the below a try:
Note:
If you can rely on the phrase "AO COVER" then just use Like "*AO COVER*"
equally if you can rely on the order of the numeric being before the other search term your could simplify to
descr Like "*4'*Riser*"

VBA Code: 
Sub CityOfTampa()

    Dim ws As Worksheet
    Dim rng As Range, arr As Variant
    Dim lastRow As Long, lastCol As Long, i As Long
    Dim descr As String
  
  
    Set ws = ActiveSheet
    With ws
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(2, "A"), .Cells(lastRow, lastCol))
        arr = rng.Value
    End With
  
    Dim dictItemLbl As Object, dictKey As String

    Set dictItemLbl = CreateObject("Scripting.dictionary")
  
    ' Load details range into Dictionary
    For i = 1 To UBound(arr)
        dictKey = arr(i, 2)
        descr = arr(i, 11)
      
        If arr(i, 14) Like "*Tampa*" And descr Like "*AO*" And descr Like "*COVER*" Then
            If Not dictItemLbl.exists(dictKey) Then
                dictItemLbl(dictKey) = i
            End If
        End If
    Next i
  
    ' Get Other rows for selected Items Labels and test for value
    For i = 1 To UBound(arr)
        dictKey = arr(i, 2)
        descr = arr(i, 11)
        If dictItemLbl.exists(dictKey) Then
            If arr(i, 14) Like "*Tampa*" Then               ' Not required if this is always the same for the Item Label
                If descr Like "*4'*" And descr Like "*Riser*" Or _
                    descr Like "*4'*" And descr Like "*Top Slab*" Or _
                    descr Like "*4'*" And descr Like "*Cone*" Or _
                    descr Like "*5'*" And descr Like "*Cone*" Then
                  
                        arr(i, 4) = arr(i, 4) & "J"
                End If

            End If
        End If

    Next i
  
    rng.Columns(4) = Application.Index(arr, 0, 4)
      
End Sub
Click to expand...
Alex, I've tested this a couple of times, in one of the files, it is adding one too many J to the end of the value in only one of the rows.

Before
1672973763382.png


After
1672973830959.png


Test file link below
www.dropbox.com

2022120031 CITY OF TAMPA.csv

Shared with Dropbox
www.dropbox.com www.dropbox.com

Sorry your code is too complicated for me, I dont even know where to start when it comes to debugging it.
Right now I am just trying to understand bits of it....
 
Upvote 0
Alex Blakenburg said:
Give the below a try:
Note:
If you can rely on the phrase "AO COVER" then just use Like "*AO COVER*"
equally if you can rely on the order of the numeric being before the other search term your could simplify to
descr Like "*4'*Riser*"

VBA Code: 
Sub CityOfTampa()

    Dim ws As Worksheet
    Dim rng As Range, arr As Variant
    Dim lastRow As Long, lastCol As Long, i As Long
    Dim descr As String
  
  
    Set ws = ActiveSheet
    With ws
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(2, "A"), .Cells(lastRow, lastCol))
        arr = rng.Value
    End With
  
    Dim dictItemLbl As Object, dictKey As String

    Set dictItemLbl = CreateObject("Scripting.dictionary")
  
    ' Load details range into Dictionary
    For i = 1 To UBound(arr)
        dictKey = arr(i, 2)
        descr = arr(i, 11)
      
        If arr(i, 14) Like "*Tampa*" And descr Like "*AO*" And descr Like "*COVER*" Then
            If Not dictItemLbl.exists(dictKey) Then
                dictItemLbl(dictKey) = i
            End If
        End If
    Next i
  
    ' Get Other rows for selected Items Labels and test for value
    For i = 1 To UBound(arr)
        dictKey = arr(i, 2)
        descr = arr(i, 11)
        If dictItemLbl.exists(dictKey) Then
            If arr(i, 14) Like "*Tampa*" Then               ' Not required if this is always the same for the Item Label
                If descr Like "*4'*" And descr Like "*Riser*" Or _
                    descr Like "*4'*" And descr Like "*Top Slab*" Or _
                    descr Like "*4'*" And descr Like "*Cone*" Or _
                    descr Like "*5'*" And descr Like "*Cone*" Then
                  
                        arr(i, 4) = arr(i, 4) & "J"
                End If

            End If
        End If

    Next i
  
    rng.Columns(4) = Application.Index(arr, 0, 4)
      
End Sub
Click to expand...
If you dont mind me asking, why did you choose to use dictionary ? Is this the best approach when it comes to solving this type of problems ?
 
Upvote 0
Ahh if would have been so much quicker if I had your sample data initially.
zack8576 said:
it is adding one too many J to the end of the value in only one of the rows.
Click to expand...
The update loop is only handling each row once, so the double J means there was already a J in your data. We can add a test to only add a J if there isn't already one there.
Rich (BB code): 
' Change this
'arr(i, 4) = arr(i, 4) & "J"
' To this
If Right(arr(i, 4), 1) <> "J" Then arr(i, 4) = arr(i, 4) & "J"

If you dont mind me asking, why did you choose to use dictionary ? Is this the best approach when it comes to solving this type of problems ?
Click to expand...
If your data is sorted so that all the same column B values are together and your AO COVER was either the first or last item for the same item type then we could get away without using something like a dictionary.
Without that the code has to loop through every single line every time it finds a line with AO COVER and Tampa in it. Manageable for a small number of rows but very slow if you have thousands.

The dictionary creates a lookup table that you can access using and index, so the code only needs to loop through the range twice.
Once to select the AO COVER / Tampa lines and create and index of Item Labels.
A second time to check each for to see if it has been selected using the dictionary index and update the record if it meets the additional criteria.
 
Upvote 0
Alex Blakenburg said:
If your data is sorted so that all the same column B values are together and your AO COVER was either the first or last item for the same item type then we could get away without using something like a dictionary
Click to expand...
yes Alex all the same values in column B are grouped together, however the cell that contains AO COVER is not the first nor the last one :(
 
Upvote 0
Alex Blakenburg said:
The dictionary creates a lookup table that you can access using and index, so the code only needs to loop through the range twice.
Once to select the AO COVER / Tampa lines and create and index of Item Labels.
A second time to check each for to see if it has been selected using the dictionary index and update the record if it meets the additional criteria.
Click to expand...
Thanks for explaining this
 
Upvote 0
Alex Blakenburg said:
The update loop is only handling each row once, so the double J means there was already a J in your data. We can add a test to only add a J if there isn't already one there.
Click to expand...
I went back and double checked, you are absolutely right, another subroutine within the same macro is adding a J to this value, before your code is executed.
I think once I figured out the problem with that subroutine, then this problem will go away. I will mark this as the solution. thanks a bunch !
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Solved
Modify the value in one cell if another cell contains a certain value
Replies
4
Views
457
ouvay
O
G
  • Question Question
Why does #VALUE error in VBA function occur when creating a ReDim Matrix of Stock prices from a Named Range?
Replies
2
Views
88
Peter_SSs
Peter_SSs
A
  • Solved
doesn't show data in listbox on form without any error in this code
Replies
6
Views
115
Abdo
A
B
  • Question Question
VBA Code to Send Mail to skip blank cells
Replies
1
Views
274
Micron
M
ExcelNewbie2020
  • Solved
extract the header of sets of non empty cell
Replies
3
Views
94
ExcelNewbie2020
ExcelNewbie2020

Forum statistics

Threads
1,223,888
Messages
6,175,212
Members
452,618
Latest member
Tam84

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