VBA - Call another macro depending on cell value

vabtroni

New Member
Joined
Aug 1, 2017
Messages
32
Office Version
  1. 365
Platform
  1. Windows
Hello everyone.

I have the following table:
exemplo.jpg


...and the following code:

VBA Code:
Sub vabtroni()
   Dim um As Range
  
   With CreateObject("scripting.dictionary")
      For Each um In Range("E4:E8")
        If um.Value <> "" Then
            .Item(um.Value) = um.Offset(, 2).Value
            .Item(um.Value + 50) = um.Offset(, 2).Value
        End If
      Next um
      For Each um In Range("B4:B8,B12:B16")
         If Not um.Comment Is Nothing Then
            um.Comment.Delete
            um.Select
            Call clear_paint
         End If
         If .Exists(um.Value) And .Item(um.Value) <> "" Then
            um.AddComment
            um.Comment.Text .Item(um.Value)
            um.Select
            ' AND THIS IS WHERE I'M STALLED
         End If
      Next um
   End With
End Sub

Resuming, this code comments cells on range B4:B8,B12:B16 depending on their values, with the remarks of each vehicle referenced on the table on the right. So far, the code runs awesome, thanks to Fluff's help here on MrExcel.

However, I'd like to mark the cells on the range according to the type of remark: green for light stuff, yellow, and red for serious stuff.

I have other macros to help me do that:
- paint_green
- paint_yellow
- paint_red
- clear_paint

At that point on the code where I comented I was stalled, I would like the code to do the following:

in each row/"um":
if value on column F = Range("I4").Value Then Call paint_green
if value on column F = Range("I5").Value Then Call paint_yellow
if value on column F = Range("I6").Value Then Call paint_red

Thanks in advance for any help on this, best regards and stay safe,
Vasco.
 

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

vabtroni

New Member
Joined
Aug 1, 2017
Messages
32
Office Version
  1. 365
Platform
  1. Windows
I tried to insert the following on the code, right up there where I said I was stalled:

VBA Code:
            If um.Offset(, 1).Value = ActiveSheet.Range("I4").Value Then Call paint_green
            If um.Offset(, 1).Value = ActiveSheet.Range("I5").Value Then Call paint_yellow
            If um.Offset(, 1).Value = ActiveSheet.Range("I6").Value Then Call paint_red

It makes sense to me, but I am kinda n00b on VBA, I understand the logic but I lack the synthax. Well, the macro run with no errors, but completely ignored these conditions and acted as if these lines weren't there. :cautious:

Am I missing something?

Cheers,
V.
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,955
Office Version
  1. 365
Platform
  1. Windows
Hi, @vabtroni
I don't understand this part:

Rich (BB code):
      For Each um In Range("E4:E8")
        If um.Value <> "" Then
            .Item(um.Value) = um.Offset(, 2).Value
            .Item(um.Value + 50) = um.Offset(, 2).Value
        End If
      Next um

If you want to populate col F (Type) then the blue lines should be:
um.Offset(, 1).Value

Then you can use the dictionary, like this:
This is untested.
VBA Code:
Sub vabtroni()
   Dim um As Range
  
   With CreateObject("scripting.dictionary")
      For Each um In Range("E4:E8")
        If um.Value <> "" Then
            .Item(um.Value) = um.Offset(, 1).Value
            .Item(um.Value + 50) = um.Offset(, 1).Value
        End If
      Next um
      For Each um In Range("B4:B8,B12:B16")
         If Not um.Comment Is Nothing Then
            um.Comment.Delete
            um.Select
            Call clear_paint
         End If
         If .Exists(um.Value) And .Item(um.Value) <> "" Then
            um.AddComment
            um.Comment.Text .Item(um.Value)
            Select Case .Item(um.Value)
                Case "Minor"
                    Call paint_green
                Case "Caution"
                    Call paint_yellow
                Case "Major"
                    Call paint_red
            End Select
            ' AND THIS IS WHERE I'M STALLED
         End If
      Next um
   End With
End Sub
Could you upload a sample workbook (without sensitive data) to a free site such as dropbox.com or google drive & then share the link here?
It will make it easier to test and find a solution.
 

vabtroni

New Member
Joined
Aug 1, 2017
Messages
32
Office Version
  1. 365
Platform
  1. Windows
Hi Akuini, thanks for your reply ;)

Right now I'm on mobile, don't have the file here.

However, I'll give you the link where this code showed up first, I'm pretty sure you'll understand there why the offset must be 2 and why I created this new thread, just follow the thread as the code was evolving. The main goal is to insert the remarks as coment for each vehicle.

This is the link: VBA Macro to comment cells according to its value

Cheers,
V.
 
Last edited:

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,955
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I'll wait for the sample file. ;)
 

vabtroni

New Member
Joined
Aug 1, 2017
Messages
32
Office Version
  1. 365
Platform
  1. Windows
Akuini:


The module 1 in VBA has the macro I'm talking about.

The module 2 has the aux macros to paint the borders.

It is important that you have checked out previously the thread I talked about, for you to understand what this macro is supposed to do ;)

Thank you in advance for your help.
 

vabtroni

New Member
Joined
Aug 1, 2017
Messages
32
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

If you want to populate col F (Type) then the blue lines should be:

It should populate col G to pick up the correct text to comment.
Is it possible also to populate col F to meet the condition on how the commented cell should be painted?
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,955
Office Version
  1. 365
Platform
  1. Windows
You need another dictionary to populate F column, like this:
VBA Code:
Sub vabtroni()
   Dim um As Range
   Dim d As Object
   
   Set d = CreateObject("scripting.dictionary")
   
   With CreateObject("scripting.dictionary")
      For Each um In Range("E4:E8")
        If um.Value <> "" Then
            .Item(um.Value) = um.Offset(, 2).Value
            .Item(um.Value + 50) = um.Offset(, 2).Value
            d.Item(um.Value) = um.Offset(, 1).Value
            d.Item(um.Value + 50) = um.Offset(, 1).Value
        End If
      Next um
      For Each um In Range("B4:B8,B12:B16")
         If Not um.Comment Is Nothing Then
            um.Comment.Delete
            um.Select
            Call clear_paint
         End If
         If .Exists(um.Value) And .Item(um.Value) <> "" Then
            um.AddComment
            um.Comment.Text .Item(um.Value)
            um.Select
' --------------------------------------------------------------------------------
' This piece of code is just being ignored and doing nothing.
' It was supposed to call the paint macros depending on the value of cell in column F
' I believe I didn't get something and the condition is not being met by the parameters I wished to
            
            
            Select Case d.Item(um.Value)
                Case "Minor"
                    Call paint_green
                Case "Caution"
                    Call paint_yellow
                Case "Major"
                    Call paint_red
            End Select
' --------------------------------------------------------------------------------
         End If
      Next um
   End With
End Sub

vabtroni.jpg
 
Solution

vabtroni

New Member
Joined
Aug 1, 2017
Messages
32
Office Version
  1. 365
Platform
  1. Windows
Thank you very very much!

Will try it soon.

However, I still have one last question. When you state Case "Minor" , Case "Caution" and Case "Major", can I relate to the cells value I4 I5 and I6 instead of relating it to the values itself? Just saying it because in the table on the right, the column F is data validation from range "I4:I6". Would it work if I stated it this way: Case Range("I4").Value etc etc?
 

vabtroni

New Member
Joined
Aug 1, 2017
Messages
32
Office Version
  1. 365
Platform
  1. Windows
Just tested, and it works perfectly. Both your solution and my final fix.

Thank you so very much, Akuini :)

Cheers everyone and stay safe 🤜
 

Watch MrExcel Video

Forum statistics

Threads
1,126,996
Messages
5,622,078
Members
415,875
Latest member
Tarali

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
Top