Macro that references another column and adds text based on what it says

[kapperson]

Hello,
I'm just getting started with trying to write macros for Excel. I have minimal JavaScript knowledge, so I understand parts of it but I'm not totally sure of the correct language. I'm trying to create a macro that will reference another cell and add a value in a different cell based on what that cell says.

For example, the logic would be something similar to this:

If cell A:1 = orange then cell P:1 = fruit.

The complex part is that I need it to run through several checks before continuing onto the next cell in the column, so it would have to go through the following:

If cell A:1 = orange then cell P:1 = fruit
If cell A:1 = desk then cell P:1 = furniture
If cell A:1 = Texas then cell P:1 = state
If cell A:1 = red then cell P:1 = color
If cell A:1 = hot then cell P:1 = temperature
If cell A:1 = shirt then cell P:1 = clothing
If cell A:1 = ring then cell P:1 = jewelry
If cell A:1 = male then cell P:1 = gender
If cell A:1 = Thursday then cell P:1 = day
If cell A:1 = Christmas then cell P:1 = holiday
If cell A:1 = dog then cell P:1 = mammal
If cell A:1 = sad then cell P:1 = emotion

The macro would have to run through all of those checks for each cell clear down until there is a blank cell in column A. Once it reaches that point, it would need to go back to the top of column A and start doing the same thing to populate the next column (Q) with values:

If cell A:1 = orange then cell Q:1 = eat
If cell A:1 = desk then cell Q:1 = write
If cell A:1 = Texas then cell Q:1 = live
If cell A:1 = red then cell Q:1 = see
If cell A:1 = hot then cell Q:1 = feel
If cell A:1 = shirt then cell Q:1 = wear
If cell A:1 = ring then cell Q:1 = wear
If cell A:1 = male then cell Q:1 = am
If cell A:1 = Thursday then cell Q:1 = is
If cell A:1 = Christmas then cell Q:1 = celebrate
If cell A:1 = dog then cell Q:1 = play
If cell A:1 = sad then cell Q:1 = cry

I need it to do this for P - AG (18 columns) and anywhere from 5,000 to 15,000 rows.
Again, I'm not sure how to take what I want to do and translate it into the code.

If you could show me a way to do this with the first two columns as I've detailed or point me in the direction of something or someone that would help me figure this out, I'd really appreciate it.

 

[Joe4]

Welcome to the Board!

No need to loop through the range multiple times. You only need to check the value in column A once for each row, and write out what you want based on that.

Here is the structure you want. I did the first three checks for the first two columns. You would just add the rest of the stuff where I show the ...

Sub MyMacro()

    Dim myLastRow As Long
    Dim myRow As Long
    
'   Find last row in column A (before first blank in column A)
    myLastRow = Range("A1").End(xlDown).Row
 
    Application.ScreenUpdating = True
    
'   Loop through all cells in column A
    For myRow = 1 To myLastRow
        Select Case Cells(myRow, "A")
            Case "orange"
                Cells(myRow, "P") = "fruit"
                Cells(myRow, "Q") = "eat"
                ...
            Case "desk"
                Cells(myRow, "P") = "furniture"
                Cells(myRow, "Q") = "write"
                ...
            Case "Texas"
                Cells(myRow, "P") = "state"
                Cells(myRow, "Q") = "live"
                ...
            Case ...
                ...
                ...
'           What  to return if value in column A not found
            Case Else
                Cells(myRow, "P") = "unknown"
                Cells(myRow, "Q") = "unknown"
                ...
        End Select
    Next myRow
    
    Application.ScreenUpdating = True
    
End Sub

 

[kapperson]

Welcome to the Board!

No need to loop through the range multiple times. You only need to check the value in column A once for each row, and write out what you want based on that.

Here is the structure you want. I did the first three checks for the first two columns. You would just add the rest of the stuff where I show the ...

Sub MyMacro()

    Dim myLastRow As Long
    Dim myRow As Long
    
'   Find last row in column A (before first blank in column A)
    myLastRow = Range("A1").End(xlDown).Row
 
    Application.ScreenUpdating = True
    
'   Loop through all cells in column A
    For myRow = 1 To myLastRow
        Select Case Cells(myRow, "A")
            Case "orange"
                Cells(myRow, "P") = "fruit"
                Cells(myRow, "Q") = "eat"
                ...
            Case "desk"
                Cells(myRow, "P") = "furniture"
                Cells(myRow, "Q") = "write"
                ...
            Case "Texas"
                Cells(myRow, "P") = "state"
                Cells(myRow, "Q") = "live"
                ...
            Case ...
                ...
                ...
'           What  to return if value in column A not found
            Case Else
                Cells(myRow, "P") = "unknown"
                Cells(myRow, "Q") = "unknown"
                ...
        End Select
    Next myRow
    
    Application.ScreenUpdating = True
    
End Sub

Thank you!! I'm going to give this a try.

 

[kapperson]

Joe4,
This did exactly what I wanted it to do! Thank you for your help!
I did have one more question: is it possible to just find part of what a cell in column A contains? For example, if column A was a path C:\Users\Desktop\orange.csv, is there a way to make the Case so that if it contains orange it does all of the following?

Thanks again for your help!

 

[Joe4]

It is probably best to pull that word out, by getting the value between the last slash and the last period in the path.

Here is some sample code that shows how you can do that (returning it to a Message Box just to prove it works):

    myEntry = "C:\Users\Desktop\orange.csv"
    
    myStart = InStrRev(myEntry, "\") + 1
    myStop = InStrRev(myEntry, ".") - 1
    
    myWordCheck = Mid(myEntry, myStart, myStop - myStart + 1)

    MsgBox myWordCheck

 

[kapperson]

I'm sorry, I'm probably showing my inexperience here...
I can understand how that works by itself, but how would I use that in the macro to pull out the word I need to use as my case?

Thanks again for all of your help!!

 

[Joe4]

Sub MyMacro()

    Dim myLastRow As Long
    Dim myRow As Long
    Dim myEntry As String
    Dim myStart As Long
    Dim myStop As Long
    Dim myWordCheck As String
        
'   Find last row in column A (before first blank in column A)
    myLastRow = Range("A1").End(xlDown).Row
 
    Application.ScreenUpdating = True
    
'   Loop through all cells in column A
    For myRow = 1 To myLastRow
'       Extract work from path
        myEntry = Range("A" & myRow)
        myStart = InStrRev(myEntry, "\") + 1
        myStop = InStrRev(myEntry, ".") - 1
        myWordCheck = Mid(myEntry, myStart, myStop - myStart + 1)

'       Set scenarios to search for
        Select Case myWordCheck
            Case "orange"
                Cells(myRow, "P") = "fruit"
                Cells(myRow, "Q") = "eat"
''                ...
            Case "desk"
                Cells(myRow, "P") = "furniture"
                Cells(myRow, "Q") = "write"
''                ...
            Case "Texas"
                Cells(myRow, "P") = "state"
                Cells(myRow, "Q") = "live"
''                ...
''            Case ...
''                ...
''                ...
'           What  to return if value in column A not found
            Case Else
                Cells(myRow, "P") = "unknown"
                Cells(myRow, "Q") = "unknown"
''                ...
        End Select
    Next myRow
    
    Application.ScreenUpdating = True
    
End Sub

 

[kapperson]

Thank you, you have been a huge help!!

 

[Joe4]

You're most welcome!

 

[kapperson]

You're most welcome!

Hi Joe4,
I wanted to thank you again for your help with this, it has worked very well for me for quite some time.
I wanted to see if you knew of an easy way to adjust this macro so that it will reference two columns and then add the necessary text to the other rows.

For example, if column A = orange and column L = 2, then row P and Q would equal fruit and eat respectively.
Whereas another could have column A = orange and column L = 1, then P and Q would equal color and draw, respectively.

Any assistance you can provide I'd really appreciate!!

Thanks!