Filling in data from source

L

Luke777

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

I'm not quite sure what to call the following type of data manipulation so I don't quite know how to phrase my question.

Below is an example of my source data

123412/12/2021 06:30chicken
444412/12/2021 06:30lamp
32112/12/2021 06:30oak
123412/12/2021 07:30blimp attack
123413/12/2021 08:30extended warranty
….….….


A:A contains part IDs (which may/will repeat). B:B contains a date and time (will always be a 15 minute chunk e.g. 06:30,06:45,07:00) associated with a sale period for the ID in A (so 6:30 may appear a few times for different IDs - but IDs will *never* appear more than once for the same time period) this column has been sorted so the earliest date/time will always be first. C:C contains data associated with the ID and Time in A and B

Below is how I wish the data to be presented - A has been transposed and filtered (unique IDs - no repeats) B is a list of date times starting at 12/12/2021 06:30 (the first time and increasing by 15 minute intervals. I have already sorted this part out which works perfectly as I want it. What I don't know how to do is get those associated bits of Data in C:C to appear in the relevant cells.

12344444321
12/12/2021 06:30chickenlampoak
12/12/2021 06:45
12/12/2021 07:00
12/12/2021 07:15
12/12/2021 07:30blimp attack
….
13/12/2021 08:30extended warranty


I should specify I'm using VBA rather than formula for this as the data set is quite large (though not in the example of course), so I'm after a VBA solution :)

Thanks for any help!
 
Sort by date Sort by votes
MoshiM said:
Oops find and replace did a number on that one. Use this:
VBA Code: 
Option Explicit

Sub sssssssss()
    Dim Main_CLCTN As New Collection, output() As Variant, Y As Long, IDs As New Collection, _
    X As Long, Specified_Time_CLCTN As Collection, datetime_key As String, Temp() As Variant, lastrow As Long
  
  
    Dim Destination_RNG As Range, Start_Time As Date, End_Time As Date, data() As Variant, new_date As Date
  
    set destination_rng= 'Reference to top left cell of where you want the data            '
  
    With ActiveSheet
  
        lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
      
        data = .Range("A2", "C" & lastrow).value
      
    End With
    Start_Time = data(1, 2)
    End_Time = data(UBound(data, 1), 2)
  
    With Main_CLCTN
  
        new_date = Start_Time
      
        Do  'Create a new collection for each 15 min interval from start time to end time
      
            datetime_key = new_date
          
            Set Specified_Time_CLCTN = New Collection
          
            Specified_Time_CLCTN.Add new_date, "Time"
          
            .Add Specified_Time_CLCTN, datetime_key
          
            new_date = DateAdd("n", 15, new_date)
          
        Loop Until new_date > End_Time
      
        For X = LBound(data, 1) To UBound(data, 1)
      
            datetime_key = data(X, 2)
            .Item(datetime_key).Add Array(data(X, 3), CStr(data(X, 1))) 'Array is (Associated term,ID to be used as key)
          
            On Error Resume Next
                'Populate collection with unique IDS to be used as headers and to specify array column location
                IDs.Add Array(IDs.Count + 2, data(X, 1)), CStr(data(X, 1)) 'Array is (column number for final array,ID) keyed to ID
            On Error GoTo 0
          
        Next X
        ReDim output(1 To .Count + 1, 1 To IDs.Count + 1)
      
    End With
    With IDs 'Fill in ID numbers at top
        For X = 1 To .Count
            output(1, X + 1) = .Item(X)(1) 'ID
        Next X
    End With
  
    With Main_CLCTN 'Create output array
      
        For X = 1 To .Count
          
            With .Item(X) 'With Time collection
              
                output(X + 1, 1) = .Item("Time")
              
                If .Count > 1 Then
                    For Y = 2 To .Count          '1st item is "Time" so start at 2
                        Temp = .Item(Y)
                        output(X + 1, IDs(Temp(1))(0)) = Temp(0)
                        'get column number from ID collection by using the stored ID as a key
                    Next Y
                End If
              
            End With
        Next X
      
    End With
  
    Destination_RNG.Resize(UBound(output, 1), UBound(output, 2)).value = output
End Sub
Click to expand...
Hi!

Thanks for the response :)

I've tried using this one, setting Sheet2 B2 as where the first data point would be inserted - unfortunately I get the error "run time error 5 invalid procedure call or argument" for the line...

VBA Code: 
.Item(datetime_key).Add Array(data(X, 3), CStr(data(X, 1))) 'Array is (Associated term,ID to be used as key)
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
alansidman said:
An alternative is to use power query.

Power Query: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Pivoted Column" = Table.Pivot(Table.TransformColumnTypes(Source, {{"Column1", type text}}, "en-US"), List.Distinct(Table.TransformColumnTypes(Source, {{"Column1", type text}}, "en-US")[Column1]), "Column1", "Column3")
in
    #"Pivoted Column"

Book10
ABCDEFGH
1Column1Column2Column3Column212344444321
2123412/12/2021 6:30chicken12/12/2021 6:30chickenlampoak
3444412/12/2021 6:30lamp12/12/2021 7:30blimp attack
432112/12/2021 6:30oak12/13/2021 8:30extended warranty
5123412/12/2021 7:30blimp attack
6123412/13/2021 8:30extended warranty
Sheet1
Click to expand...
Hi there and thank you for your response :)

I'm unfamiliar with power query and using pivot - does this literally just pivot the data by creating different axes out of A and B as they appear in the first table or is it capable of placing the data on existing axes? For example, column A of where I want the data to appear has 144 15 minute time slots (36 hour period) whereas the source data might not have entries for all time slots.
 
Upvote 0
Luke777 said:
Hi!

Thanks for the response :)

I've tried using this one, setting Sheet2 B2 as where the first data point would be inserted - unfortunately I get the error "run time error 5 invalid procedure call or argument" for the line...

VBA Code: 
.Item(datetime_key).Add Array(data(X, 3), CStr(data(X, 1))) 'Array is (Associated term,ID to be used as key)
Click to expand...
Seems like you have an empty date value in the source range. Tell me how this goes >
VBA Code: 
Option Explicit

Sub sssssssss()
    Dim Main_CLCTN As New Collection, output() As Variant, Y As Long, IDs As New Collection, _
    X As Long, Specified_Time_CLCTN As Collection, datetime_key As String, Temp() As Variant, lastrow As Long
   
   
    Dim Destination_RNG As Range, Start_Time As Date, End_Time As Date, data() As Variant, new_date As Date, id_code As String
   
    Set Destination_RNG = ThisWorkbook.Worksheets("Sheet2").Range("B2") 'Thisworkbook.worksheets(" ").Range(" ")   Reference to top left cell of where you want the data            '
   
    With ActiveSheet
   
        lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
       
        data = .Range("A2", "C" & lastrow).Value
       
    End With
    
    
    Start_Time = data(1, 2)
    End_Time = data(UBound(data, 1), 2)
   
    With Main_CLCTN
   
        new_date = Start_Time
       
        Do  'Create a new collection for each 15 min interval from start time to end time
       
            datetime_key = new_date
           
            Set Specified_Time_CLCTN = New Collection
           
            Specified_Time_CLCTN.Add new_date, "Time"
           
            .Add Specified_Time_CLCTN, datetime_key
           
            new_date = DateAdd("n", 15, new_date)
           
        Loop Until new_date > End_Time
       
        For X = LBound(data, 1) To UBound(data, 1)
            
            datetime_key = data(X, 2)
            id_code = data(X, 1)
            
            On Error GoTo Missing_Key
            
            .Item(datetime_key).Add Array(data(X, 3), id_code) 'Array is (Associated term,ID to be used as key)
           
            On Error Resume Next
                'Populate collection with unique IDS to be used as headers and to specify array column location
                IDs.Add Array(IDs.Count + 2, data(X, 1)), id_code 'Array is (column number for final array,ID) keyed to ID
            On Error GoTo 0
            
Next_Row_Parse:

        Next X

        ReDim output(1 To .Count + 1, 1 To IDs.Count + 1)
       
    End With
    With IDs 'Fill in ID numbers at top
        For X = 1 To .Count
            output(1, X + 1) = .Item(X)(1) 'ID
        Next X
    End With
   
    With Main_CLCTN 'Create output array
       
        For X = 1 To .Count
           
            With .Item(X) 'With Time collection
               
                output(X + 1, 1) = .Item("Time")
               
                If .Count > 1 Then
                    For Y = 2 To .Count          '1st item is "Time" so start at 2
                        Temp = .Item(Y)
                        output(X + 1, IDs(Temp(1))(0)) = Temp(0)
                        'get column number from ID collection by using the stored ID as a key
                    Next Y
                End If
               
            End With
        Next X
       
    End With
   
    Destination_RNG.Resize(UBound(output, 1), UBound(output, 2)).Value = output

Exit Sub
Missing_Key:
    Resume Next_Row_Parse
    
End Sub
 
Upvote 0
MoshiM said:
Seems like you have an empty date value in the source range. Tell me how this goes >
VBA Code: 
Option Explicit

Sub sssssssss()
    Dim Main_CLCTN As New Collection, output() As Variant, Y As Long, IDs As New Collection, _
    X As Long, Specified_Time_CLCTN As Collection, datetime_key As String, Temp() As Variant, lastrow As Long
  
  
    Dim Destination_RNG As Range, Start_Time As Date, End_Time As Date, data() As Variant, new_date As Date, id_code As String
  
    Set Destination_RNG = ThisWorkbook.Worksheets("Sheet2").Range("B2") 'Thisworkbook.worksheets(" ").Range(" ")   Reference to top left cell of where you want the data            '
  
    With ActiveSheet
  
        lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
      
        data = .Range("A2", "C" & lastrow).Value
      
    End With
   
   
    Start_Time = data(1, 2)
    End_Time = data(UBound(data, 1), 2)
  
    With Main_CLCTN
  
        new_date = Start_Time
      
        Do  'Create a new collection for each 15 min interval from start time to end time
      
            datetime_key = new_date
          
            Set Specified_Time_CLCTN = New Collection
          
            Specified_Time_CLCTN.Add new_date, "Time"
          
            .Add Specified_Time_CLCTN, datetime_key
          
            new_date = DateAdd("n", 15, new_date)
          
        Loop Until new_date > End_Time
      
        For X = LBound(data, 1) To UBound(data, 1)
           
            datetime_key = data(X, 2)
            id_code = data(X, 1)
           
            On Error GoTo Missing_Key
           
            .Item(datetime_key).Add Array(data(X, 3), id_code) 'Array is (Associated term,ID to be used as key)
          
            On Error Resume Next
                'Populate collection with unique IDS to be used as headers and to specify array column location
                IDs.Add Array(IDs.Count + 2, data(X, 1)), id_code 'Array is (column number for final array,ID) keyed to ID
            On Error GoTo 0
           
Next_Row_Parse:

        Next X

        ReDim output(1 To .Count + 1, 1 To IDs.Count + 1)
      
    End With
    With IDs 'Fill in ID numbers at top
        For X = 1 To .Count
            output(1, X + 1) = .Item(X)(1) 'ID
        Next X
    End With
  
    With Main_CLCTN 'Create output array
      
        For X = 1 To .Count
          
            With .Item(X) 'With Time collection
              
                output(X + 1, 1) = .Item("Time")
              
                If .Count > 1 Then
                    For Y = 2 To .Count          '1st item is "Time" so start at 2
                        Temp = .Item(Y)
                        output(X + 1, IDs(Temp(1))(0)) = Temp(0)
                        'get column number from ID collection by using the stored ID as a key
                    Next Y
                End If
              
            End With
        Next X
      
    End With
  
    Destination_RNG.Resize(UBound(output, 1), UBound(output, 2)).Value = output

Exit Sub
Missing_Key:
    Resume Next_Row_Parse
   
End Sub
Click to expand...
Okay, we're getting somewhere now :D

Below is my blank grid/table thingy - the times in A go down to A148

12344444321
12/12/2021 06:30
12/12/2021 06:45
12/12/2021 07:00
12/12/2021 07:15
12/12/2021 07:30
12/12/2021 07:45
12/12/2021 08:00
12/12/2021 08:15
12/12/2021 08:30
12/12/2021 08:45
12/12/2021 09:00
12/12/2021 09:15
12/12/2021 09:30
12/12/2021 09:45
12/12/2021 10:00
12/12/2021 10:15


the example table is exactly as below (real data set will be longer)

123412/12/2021 06:30chicken
444412/12/2021 06:30lamp
32112/12/2021 06:30oak
123412/12/2021 07:30blimp attack
123413/12/2021 08:30extended warranty


and the result using the your code is...

12344444321
12/12/2021 06:3044443211234
12/12/2021 06:4512/12/2021lampoak
12/12/2021 07:0012/12/2021 06:45
12/12/2021 07:1512/12/2021 07:00
12/12/2021 07:3012/12/2021 07:15
12/12/2021 07:4512/12/2021 07:30blimp attack
12/12/2021 08:0012/12/2021 07:45
12/12/2021 08:1512/12/2021 08:00
12/12/2021 08:3012/12/2021 08:15
12/12/2021 08:4512/12/2021 08:30
12/12/2021 09:0012/12/2021 08:45
12/12/2021 09:1512/12/2021 09:00
12/12/2021 09:3012/12/2021 09:15
12/12/2021 09:4512/12/2021 09:30
12/12/2021 10:0012/12/2021 09:45
12/12/2021 10:1512/12/2021 10:00
12/12/2021 10:3012/12/2021 10:15
12/12/2021 10:4512/12/2021 10:30
12/12/2021 11:0012/12/2021 10:45
12/12/2021 11:1512/12/2021 11:00
12/12/2021 11:3012/12/2021 11:15
12/12/2021 11:4512/12/2021 11:30
12/12/2021 12:0012/12/2021 11:45
12/12/2021 12:1512/12/2021 12:00


so we're definitely heading in the right direction - should also say that the result i just showed you goes down further but I can't show the entire thing :)

So it looks like we're getting the IDs and date/times added which we don't need (as they're already there) - but it is putting the data in the right place relative to the times and IDs its handling
 
Upvote 0
Luke777 said:
Okay, we're getting somewhere now :D

Below is my blank grid/table thingy - the times in A go down to A148

12344444321
12/12/2021 06:30
12/12/2021 06:45
12/12/2021 07:00
12/12/2021 07:15
12/12/2021 07:30
12/12/2021 07:45
12/12/2021 08:00
12/12/2021 08:15
12/12/2021 08:30
12/12/2021 08:45
12/12/2021 09:00
12/12/2021 09:15
12/12/2021 09:30
12/12/2021 09:45
12/12/2021 10:00
12/12/2021 10:15


the example table is exactly as below (real data set will be longer)

123412/12/2021 06:30chicken
444412/12/2021 06:30lamp
32112/12/2021 06:30oak
123412/12/2021 07:30blimp attack
123413/12/2021 08:30extended warranty


and the result using the your code is...

12344444321
12/12/2021 06:3044443211234
12/12/2021 06:4512/12/2021lampoak
12/12/2021 07:0012/12/2021 06:45
12/12/2021 07:1512/12/2021 07:00
12/12/2021 07:3012/12/2021 07:15
12/12/2021 07:4512/12/2021 07:30blimp attack
12/12/2021 08:0012/12/2021 07:45
12/12/2021 08:1512/12/2021 08:00
12/12/2021 08:3012/12/2021 08:15
12/12/2021 08:4512/12/2021 08:30
12/12/2021 09:0012/12/2021 08:45
12/12/2021 09:1512/12/2021 09:00
12/12/2021 09:3012/12/2021 09:15
12/12/2021 09:4512/12/2021 09:30
12/12/2021 10:0012/12/2021 09:45
12/12/2021 10:1512/12/2021 10:00
12/12/2021 10:3012/12/2021 10:15
12/12/2021 10:4512/12/2021 10:30
12/12/2021 11:0012/12/2021 10:45
12/12/2021 11:1512/12/2021 11:00
12/12/2021 11:3012/12/2021 11:15
12/12/2021 11:4512/12/2021 11:30
12/12/2021 12:0012/12/2021 11:45
12/12/2021 12:1512/12/2021 12:00


so we're definitely heading in the right direction - should also say that the result i just showed you goes down further but I can't show the entire thing :)

So it looks like we're getting the IDs and date/times added which we don't need (as they're already there) - but it is putting the data in the right place relative to the times and IDs its handling
Click to expand...
Ahh hold on - I was setting the cell to B2 instead of A1 because I thought it worked differently to how it does... what a goose.

Am i correct in thinking that any information already held in row 1 and column A of sheet2 will be overwritten?
 
Upvote 0
Luke777 said:
Ahh hold on - I was setting the cell to B2 instead of A1 because I thought it worked differently to how it does... what a goose.

Am i correct in thinking that any information already held in row 1 and column A of sheet2 will be overwritten?
Click to expand...
Yes but if you use the following then it won't, but you'd have to keep the B2 >
VBA Code: 
Option Explicit
Sub sssssssss()
    Dim Main_CLCTN As New Collection, output() As Variant, Y As Long, _
    X As Long, Specified_Time_CLCTN As Collection, datetime_key As String, lastrow As Long
   
   
    Dim Destination_RNG As Range, Start_Time As Date, End_Time As Date, data() As Variant, _
    new_date As Date, id_code As String, schema() As Variant, Success_Count As Long
   
    Set Destination_RNG = ThisWorkbook.Worksheets("Sheet2").Range("B2") 'Thisworkbook.worksheets(" ").Range(" ")   Reference to top left cell of where you want the data            '
   
    With ActiveSheet
   
        lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
       
        data = .Range("A2", "C" & lastrow).Value
       
    End With
    
    
    Start_Time = data(1, 2)
    End_Time = data(UBound(data, 1), 2)
   
    With Main_CLCTN
   
        new_date = Start_Time
       
        Do  'Create a new collection for each 15 min interval from start time to end time
       
            datetime_key = new_date
           
            Set Specified_Time_CLCTN = New Collection
           
            .Add Specified_Time_CLCTN, datetime_key
           
            new_date = DateAdd("n", 15, new_date)
           
        Loop Until new_date > End_Time
       
        For X = LBound(data, 1) To UBound(data, 1)
            
            datetime_key = data(X, 2)
            id_code = data(X, 1)
            
            On Error GoTo Missing_Key
            
            .Item(datetime_key).Add data(X, 3), id_code
Next_Row_Parse:
        Next X
    End With
    schema = ThisWorkbook.Worksheets("Sheet2").UsedRange.Value
   
    ReDim output(1 To UBound(schema, 1) - 1, 1 To UBound(schema, 2) - 1)
    
    With Main_CLCTN
   
        For X = LBound(schema, 1) + 1 To UBound(schema, 1)
            
            On Error GoTo output_creation_date_missing
            
            Set Specified_Time_CLCTN = .Item(CStr(CDate(schema(X, 1))))
            
            On Error Resume Next
            
            With Specified_Time_CLCTN
            
                If .Count > 0 Then
                    
                    For Y = LBound(schema, 2) + 1 To UBound(schema, 2)
                        
                        output(X - 1, Y - 1) = .Item(CStr(schema(1, Y)))
                        
                        If Err.Number = 0 Then
                            Success_Count = Success_Count + 1
                            If Success_Count = .Count Then Exit For
                        Else
                            Err.Clear
                        End If
                        
                    Next Y
                    
                    Success_Count = 0
                    
                End If
                
            End With
            
output_creation_next_row:
        Next X
    
    End With
    
    On Error GoTo 0
    
    Destination_RNG.Resize(UBound(output, 1), UBound(output, 2)).Value = output
Exit Sub
Missing_Key:
    Resume Next_Row_Parse
  
output_creation_date_missing:
    Resume output_creation_next_row
End Sub
 
Upvote 0
MoshiM said:
Yes but if you use the following then it won't, but you'd have to keep the B2 >
VBA Code: 
Option Explicit
Sub sssssssss()
    Dim Main_CLCTN As New Collection, output() As Variant, Y As Long, _
    X As Long, Specified_Time_CLCTN As Collection, datetime_key As String, lastrow As Long
  
  
    Dim Destination_RNG As Range, Start_Time As Date, End_Time As Date, data() As Variant, _
    new_date As Date, id_code As String, schema() As Variant, Success_Count As Long
  
    Set Destination_RNG = ThisWorkbook.Worksheets("Sheet2").Range("B2") 'Thisworkbook.worksheets(" ").Range(" ")   Reference to top left cell of where you want the data            '
  
    With ActiveSheet
  
        lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
      
        data = .Range("A2", "C" & lastrow).Value
      
    End With
   
   
    Start_Time = data(1, 2)
    End_Time = data(UBound(data, 1), 2)
  
    With Main_CLCTN
  
        new_date = Start_Time
      
        Do  'Create a new collection for each 15 min interval from start time to end time
      
            datetime_key = new_date
          
            Set Specified_Time_CLCTN = New Collection
          
            .Add Specified_Time_CLCTN, datetime_key
          
            new_date = DateAdd("n", 15, new_date)
          
        Loop Until new_date > End_Time
      
        For X = LBound(data, 1) To UBound(data, 1)
           
            datetime_key = data(X, 2)
            id_code = data(X, 1)
           
            On Error GoTo Missing_Key
           
            .Item(datetime_key).Add data(X, 3), id_code
Next_Row_Parse:
        Next X
    End With
    schema = ThisWorkbook.Worksheets("Sheet2").UsedRange.Value
  
    ReDim output(1 To UBound(schema, 1) - 1, 1 To UBound(schema, 2) - 1)
   
    With Main_CLCTN
  
        For X = LBound(schema, 1) + 1 To UBound(schema, 1)
           
            On Error GoTo output_creation_date_missing
           
            Set Specified_Time_CLCTN = .Item(CStr(CDate(schema(X, 1))))
           
            On Error Resume Next
           
            With Specified_Time_CLCTN
           
                If .Count > 0 Then
                   
                    For Y = LBound(schema, 2) + 1 To UBound(schema, 2)
                       
                        output(X - 1, Y - 1) = .Item(CStr(schema(1, Y)))
                       
                        If Err.Number = 0 Then
                            Success_Count = Success_Count + 1
                            If Success_Count = .Count Then Exit For
                        Else
                            Err.Clear
                        End If
                       
                    Next Y
                   
                    Success_Count = 0
                   
                End If
               
            End With
           
output_creation_next_row:
        Next X
   
    End With
   
    On Error GoTo 0
   
    Destination_RNG.Resize(UBound(output, 1), UBound(output, 2)).Value = output
Exit Sub
Missing_Key:
    Resume Next_Row_Parse
 
output_creation_date_missing:
    Resume output_creation_next_row
End Sub
Click to expand...
Ahh I think I've got that working now. Sorry I've been a total pain (and still will be lol) with this.

I could do with understanding it a little better - how is the data being matched with the times in A2 and down? or is it not actually being matched but rather placed by where it thinks the positions of those times are? Because I'm trying to make it fit slightly more dynamically - for example if I change A2 to an earlier start time, and the first time in the source data, it gets ignored and skips straight to wherever that 06:30 start time is

Again, sorry to be a pain

I should explain that with the code I've already got (that creates axes of the grid I showed earlier) the first time in A2 will always be whatever the earliest start time in the source data is - so the times shift dynamically in that way. The ID's in row 1 will always be unique and in order of first appearance as per the source data (I think this bit is fine though).

I've not done a very good job at explaining the specifics of my requirements, so I apologise for that.
 
Upvote 0
Luke777 said:
Ahh I think I've got that working now. Sorry I've been a total pain (and still will be lol) with this.

I could do with understanding it a little better - how is the data being matched with the times in A2 and down? or is it not actually being matched but rather placed by where it thinks the positions of those times are? Because I'm trying to make it fit slightly more dynamically - for example if I change A2 to an earlier start time, and the first time in the source data, it gets ignored and skips straight to wherever that 06:30 start time is

Again, sorry to be a pain

I should explain that with the code I've already got (that creates axes of the grid I showed earlier) the first time in A2 will always be whatever the earliest start time in the source data is - so the times shift dynamically in that way. The ID's in row 1 will always be unique and in order of first appearance as per the source data (I think this bit is fine though).

I've not done a very good job at explaining the specifics of my requirements, so I apologise for that.
Click to expand...
This explanation assumes that you are using the more recent code that I replied with. The first one does something similar but the 2nd is easier to explain.

Starting with the Do Loop at the top; Since your data is date sorted the loop will store a new collection for every 15 minute interval from your first time to your last using the calculated datetime converted to a string as a key.

The next loop populates each of those collections with the terms found in column 3 and uses the id numbers converted to a string as a key

Then the Axes on "Sheet2" are loaded into the array named schema.
Then the script loops through each row of schema and uses column 1 (where your dates should be) as a string to reference the appropriate Collection found within Main_CLCTN. If the given collection exists then column headers ( ID numbers) are converted to a string are tested to see if they exist in the collection. If found the array value is filled in.

If you are adding new times before 6:30 ensure that you are also adding values to columns 1(ID) and 3 (Term) else it will be ignored.

Also note: You can avoid unnecessary collection generation by converting the Do loop and the following next loop to
VBA Code: 
    With Main_CLCTN
       
       on error resume next
        For X = LBound(data, 1) To UBound(data, 1)
            
            datetime_key = data(X, 2)
            id_code = data(X, 1)
            .add new Collection,datetime_key
            
            'On Error GoTo Missing_Key
            
            .Item(datetime_key).Add data(X, 3), id_code
Next_Row_Parse:
        Next X
    End With
 
Upvote 0
MoshiM said:
This explanation assumes that you are using the more recent code that I replied with. The first one does something similar but the 2nd is easier to explain.

Starting with the Do Loop at the top; Since your data is date sorted the loop will store a new collection for every 15 minute interval from your first time to your last using the calculated datetime converted to a string as a key.

The next loop populates each of those collections with the terms found in column 3 and uses the id numbers converted to a string as a key

Then the Axes on "Sheet2" are loaded into the array named schema.
Then the script loops through each row of schema and uses column 1 (where your dates should be) as a string to reference the appropriate Collection found within Main_CLCTN. If the given collection exists then column headers ( ID numbers) are converted to a string are tested to see if they exist in the collection. If found the array value is filled in.

If you are adding new times before 6:30 ensure that you are also adding values to columns 1(ID) and 3 (Term) else it will be ignored.

Also note: You can avoid unnecessary collection generation by converting the Do loop and the following next loop to
VBA Code: 
    With Main_CLCTN
      
       on error resume next
        For X = LBound(data, 1) To UBound(data, 1)
           
            datetime_key = data(X, 2)
            id_code = data(X, 1)
            .add new Collection,datetime_key
           
            'On Error GoTo Missing_Key
           
            .Item(datetime_key).Add data(X, 3), id_code
Next_Row_Parse:
        Next X
    End With
Click to expand...
Thank you for your explanation!

I'm getting some funny results though - I've added an earlier time like you mentioned with the necessary source info too - this is what I get and im not sure why - is something missing?

123412/12/2021 06:00chicken
444412/12/2021 06:30lamp
32112/12/2021 06:30oak
123412/12/2021 07:30blimp attack


12434444321
12/12/2021 06:00
12/12/2021 06:15
12/12/2021 06:30lampoak
12/12/2021 06:45
 
Upvote 0
Luke777 said:
Thank you for your explanation!

I'm getting some funny results though - I've added an earlier time like you mentioned with the necessary source info too - this is what I get and im not sure why - is something missing?

123412/12/2021 06:00chicken
444412/12/2021 06:30lamp
32112/12/2021 06:30oak
123412/12/2021 07:30blimp attack


12434444321
12/12/2021 06:00
12/12/2021 06:15
12/12/2021 06:30lampoak
12/12/2021 06:45
Click to expand...
What stands out immediately to me is that you have 1234 as an id in the source and 1243 as a column name in the output. Double check the script you are using to generate the column names.

Ignore the following if you have already done the optimization step mentioned in my previous reply.
VBA Code: 
Option Explicit
Sub sssssssss()
    Dim Main_CLCTN As New Collection, output() As Variant, Y As Long, _
    X As Long, Specified_Time_CLCTN As Collection, datetime_key As String, lastrow As Long
    Dim Destination_RNG As Range, data() As Variant, _
    id_code As String, schema() As Variant, Success_Count As Long, ids() as string
   
    Set Destination_RNG = ThisWorkbook.Worksheets("Sheet2").Range("B2") 'Thisworkbook.worksheets(" ").Range(" ")   Reference to top left cell of where you want the data            '
   
    With ActiveSheet
   
        lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
       
        data = .Range("A2", "C" & lastrow).Value
       
    End With
    
    With Main_CLCTN
       
       on error resume next
        For X = LBound(data, 1) To UBound(data, 1)
            
            datetime_key = data(X, 2)
            id_code = data(X, 1)
            .add new Collection,datetime_key
            
            'On Error GoTo Missing_Key
            
            .Item(datetime_key).Add data(X, 3), id_code
Next_Row_Parse:
        Next X
    End With
    schema = ThisWorkbook.Worksheets("Sheet2").UsedRange.Value
    
    redim ids(1 to ubound(schema,2))
    for x=lbound(schema,2) +1 to ubound(schema,2)
        ids(x-1)=cstr(schema(1,x))
    next x
    ReDim output(1 To UBound(schema, 1) - 1, 1 To UBound(schema, 2) - 1)
    
    With Main_CLCTN
   
        For X = LBound(schema, 1) + 1 To UBound(schema, 1)
            
            On Error GoTo output_creation_date_missing
            
            Set Specified_Time_CLCTN = .Item(CStr(CDate(schema(X, 1))))
            
            On Error Resume Next
            
            With Specified_Time_CLCTN
            
                If .Count > 0 Then
                    
                    For Y = LBound(ids)  To UBound(ids)
                        
                        output(X - 1, Y) = .Item(ids(y))
                        
                        If Err.Number = 0 Then
                            Success_Count = Success_Count + 1
                            If Success_Count = .Count Then Exit For
                        Else
                            Err.Clear
                        End If
                        
                    Next Y
                    
                    Success_Count = 0
                    
                End If
                
            End With
            
output_creation_next_row:
        Next X
    
    End With
    
    On Error GoTo 0
    
    Destination_RNG.Resize(UBound(output, 1), UBound(output, 2)).Value = output
Exit Sub
Missing_Key:
    Resume Next_Row_Parse
  
output_creation_date_missing:
    Resume output_creation_next_row
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Help Please
2 3
Replies
21
Views
532
Asbestos_Jen
Asbestos_Jen
A
  • Solved
lookupifs?? lookup value so long as date value is greater than specified date
Replies
5
Views
117
Peter_SSs
Peter_SSs
C
  • Solved
Extract Dates from 2 columns
Replies
2
Views
654
Peter_SSs
Peter_SSs
T
  • Solved
Date of Max value
Replies
5
Views
380
Fluff
Fluff
M
  • Question Question
Best solution to consolidate values that occur on multiple dates/lines
Replies
5
Views
452
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,803
Messages
6,181,055
Members
453,015
Latest member
ZochSteveo

Share this page

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