Consulting

Results 1 to 2 of 2

Thread: Need help with my VBA Dictionary task

  1. #1
    VBAX Regular
    Joined
    Apr 2018
    Posts
    12
    Location

    Need help with my VBA Dictionary task

    Hi everyone,
    I am working on a task where I need to make a range of cells within the same row equal to 0 if a condition is met. The condition is that cells(2,9) is equal to a string representing an event. I use a dictionary to associate events (strings) to a date.


    My events are static, they do not change. However, the date associated with the event can change and can be edited by the user. When cells(2,9) contain a certain event, I want my code to recognize that this event is associated to a date 'X' and make a 'Y' range of cells equal to 0 based on date 'X'.

    3 things I need help with:


    1. One problem I have is that I cannot have two dates for a same event or else I run into an error when I run the code.
    2. How can I write my code in a more efficient way ( less line of codes), in order to avoid redundancy
    3. Every time I run the code I also want to erase whatever content/formatting done due to a prior run of the code.

    My code is as per below, any help is appreciated!

    Sub testMAC()
        Dim dict As New Scripting.Dictionary
        
      
        
        dict.Add Key:=CDate("01/01/19"), Item:="event1"
        dict.Add Key:=CDate("01/02/19"), Item:="event2"
        dict.Add Key:=CDate("01/03/19"), Item:="event3"
        dict.Add Key:=CDate("01/04/19"), Item:="event4"
        dict.Add Key:=CDate("01/05/19"), Item:="event5"
        dict.Add Key:=CDate("01/06/19"), Item:="event6"
          
      
          
          
     
          
          
        If Cells(2, 9) = dict.Item(CDate("01/01/19")) Then
    Cells.Range("B2:H2").Interior.ColorIndex = 16
    Cells.Range("B2:H2").Value = 0
    
    
    ElseIf Cells(2, 9) = dict.Item(CDate("01/02/19")) Then
       Cells.Range("C2:H2").Interior.ColorIndex = 16
       Cells.Range("C2:H2").Value = 0
       
       ElseIf Cells(2, 9) = dict.Item(CDate("01/02/19")) Then
       Cells.Range("D2:H2").Interior.ColorIndex = 16
       Cells.Range("D2:H2").Value = 0
       
       ElseIf Cells(2, 9) = dict.Item(CDate("01/03/19")) Then
       Cells.Range("E2:H2").Interior.ColorIndex = 16
       Cells.Range("E2:H2").Value = 0
       
       ElseIf Cells(2, 9) = dict.Item(CDate("01/04/19")) Then
       Cells.Range("F2:H2").Interior.ColorIndex = 16
       Cells.Range("F2:H2").Value = 0
       
       ElseIf Cells(2, 9) = dict.Item(CDate("01/02/19")) Then
       Cells.Range("H2:H2").Interior.ColorIndex = 16
       Cells.Range("H2:H2").Value = 0
       
       
        
        End If
        
    End Sub

  2. #2
    In the code you've posted the dates are irrelevant, so it could be condensed to
    Sub testMAC()
       Dim dict As Object
       
       Range("B2:H2").Interior.ColorIndex = xlNone
       Set dict = CreateObject("scripting.dictionary")
       dict.Add "event1", Range("B2:H2")
       dict.Add "event2", Range("C2:H2")
       dict.Add "event3", Range("D2:H2")
       dict.Add "event4", Range("E2:H2")
       dict.Add "event5", Range("F2:H2")
       dict.Add "event6", Range("H2")
       
       With dict(Cells(2, 9).Value)
          .Interior.ColorIndex = 16
          .Value = 0
       End With
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •