Scripting Dictionary Loop Find and Replace

Luke777

Board Regular
Joined
Aug 10, 2020
Messages
243
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I'm using the following code to find the first and last value of "286" in column A - the output in V1 is the combined times of the first "286" and the relevant time in K and the last "286" and the relevant time in L.

VBA Code:
Sub StartEndTimes()

    Dim StartRow As Integer, EndRow As Integer
    Dim StartTime As String, EndTime As String, StartEndTime As String
      
    With Sheets(7)
        StartRow = .Range("A:A").Find(what:="286", after:=Range("A1")).Row
        EndRow = .Range("A:A").Find(what:="286", after:=Range("A1"), searchdirection:=xlPrevious).Row
    End With

    StartTime = Range("K" & StartRow)
    EndTime = Range("L" & EndRow)

    StartEndTime = Format(StartTime, "h:mm") & "-" & Format(EndTime, "h:mm")
    
    Range("V1") = StartEndTime
    
End Sub

I'm trying to use a scripting dictionary to replace "286" with all the unique values that are found in Column A, loop through them, and dump the resulting values in a list starting with V1.

I got this far...

VBA Code:
Sub StartEndTimes()

    Dim StartRow As Integer, EndRow As Integer
    Dim StartTime As String, EndTime As String, StartEndTime As String
    
    Dim Dic As Object
    Dim A1 As Range
    
    Set Dic = CreateObject("scripting.dictionary")
      
    With Sheets(7)
        StartRow = .Range("A:A").Find(what:="286", after:=Range("A1")).Row
        EndRow = .Range("A:A").Find(what:="286", after:=Range("A1"), searchdirection:=xlPrevious).Row
    End With

    StartTime = Range("K" & StartRow)
    EndTime = Range("L" & EndRow)

    StartEndTime = Format(StartTime, "h:mm") & "-" & Format(EndTime, "h:mm")
    
    Range("V1") = StartEndTime
    
End Sub

But I'm unsure how to combine the what I've already got and the necessary For Each A1

Any help would be greatly appreciated!
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Try this:
Assuming the data starts at row 2. Values in V2 and times in W2 and down.

VBA Code:
Sub StartEndTimes()
  Dim a As Variant, s As String
  Dim dic As Object
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A2:L" & Range("A" & Rows.Count).End(3).Row).Value
  
  For i = 1 To UBound(a)
    If Not dic.exists(a(i, 1)) Then s = Format(a(i, 11), "h:mm") Else s = Split(dic(a(i, 1)), "-")(0)
    dic(a(i, 1)) = s & "-" & Format(a(i, 12), "h:mm")
  Next
  Range("V2").Resize(dic.Count, 2).Value = Application.Transpose(Array(dic.keys, dic.items))
End Sub
 
Upvote 0
Solution
Try this:
Assuming the data starts at row 2. Values in V2 and times in W2 and down.

VBA Code:
Sub StartEndTimes()
  Dim a As Variant, s As String
  Dim dic As Object
  Dim i As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A2:L" & Range("A" & Rows.Count).End(3).Row).Value
 
  For i = 1 To UBound(a)
    If Not dic.exists(a(i, 1)) Then s = Format(a(i, 11), "h:mm") Else s = Split(dic(a(i, 1)), "-")(0)
    dic(a(i, 1)) = s & "-" & Format(a(i, 12), "h:mm")
  Next
  Range("V2").Resize(dic.Count, 2).Value = Application.Transpose(Array(dic.keys, dic.items))
End Sub
This is actually better than what I'd hoped for and removes the need for most of a module I'd already completed that works with the numbers in A and doesn't use the times.

If you've got time, I'd be very appreciative of a walk through of what's going on so I can stop nagging busy people like yourself for help :D

I think i understand perfectly up to and including where the range is set for "a" though I was surprised to see A1:L rather than just A1:Awhatever - definitely a trick to remember.

I'm not exactly sure how it works, but I think the line with "For - = 1 To UBound (a)" translates to "for every value in column 1 of the the range we labeled 'a'...

Then I'm slightly lost with "If Not dic.Exists(a(i, 1))" though I do recognise that the function after this is the time format stuff I was doing before.

but if I'm looking at it correctly, the loop adds items to the dictionary as it cycles through them and then the last line dumps the dictionary in V2 once there's nothing left to loop through in A?
 
Upvote 0
I add some comments to the code.

VBA Code:
Sub StartEndTimes()
  Dim a As Variant, s As String
  Dim dic As Object
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  'Load in the matrix 'a' from "A2:L" and until the last row with data.
  'It can be done directly by reading each cell, but this way it is faster.
  a = Range("A2:L" & Range("A" & Rows.Count).End(3).Row).Value
  
  For i = 1 To UBound(a)
    'If it doesn't exist in the dictionary,
    's = start date of column "K" (a(i, 11))
    'if it already exists in the dictionary,
    'then s = the first data stored in the dictionary item (before the "-")
    If Not dic.exists(a(i, 1)) Then s = Format(a(i, 11), "h:mm") Else s = Split(dic(a(i, 1)), "-")(0)
    
    'Three pieces of information are stored in the dictionary:
    '1, as a key column "A" (a(i, 1))
    '2, as the first part of item the value of variable s
    '3, as the second part of item the value of column "L" (a(i, 12))
    dic(a(i, 1)) = s & "-" & Format(a(i, 12), "h:mm")
  Next
  'Download dictionary content
  Range("V2").Resize(dic.Count, 2).Value = Application.Transpose(Array(dic.keys, dic.items))
End Sub

If it is difficult to follow the reading of the matrix.
Here I show you a version to read directly from the cells.

VBA Code:
Sub StartEndTimes_2()
  Dim c As Range, s As String
  Dim dic As Object
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  For Each c In Range("A2", Range("A" & Rows.Count).End(3))
    If Not dic.exists(c.Value) Then s = Format(c.Offset(, 10), "h:mm") Else s = Split(dic(c.Value), "-")(0)
    dic(c.Value) = s & "-" & Format(c.Offset(, 11), "h:mm")
  Next
  Range("V2").Resize(dic.Count, 2).Value = Application.Transpose(Array(dic.keys, dic.items))
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

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