PDA

View Full Version : Need help with my VBA Dictionary task



omar23j
11-02-2018, 08:18 AM
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:


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.
How can I write my code in a more efficient way ( less line of codes), in order to avoid redundancy
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

Fluff
11-03-2018, 11:26 AM
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