Help converting table of data into new layout

[PFDave]

Hi,

I can't really explain enough in the subject so here's hoping I get the right audience

I run an SQL query, I export this to Excel which gives me a list of different locations in column A and then the start and end hours of those locations in Columns B through O

What I require as an output is on Desired Output sheet.

I want to know the start and end hours for each different day, and then from that I want to establish which of those days is BDH (late opening) by looking at the average start time only including M-F.

The range will be ever changing so the number of locations changes when new ones are created.

Could anyone offer some help on this please?

I use the below code to create 7 values of each entry in column A of sheet 1, but I can't work out what to do to continue the process for the other fields as they are not simply drag down formulae.

Sub insertit()
    Dim i As Long
    Application.ScreenUpdating = False
    For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Cells(i, 1) <> Cells(i + 1, 1) Or Cells(i, 2) <> Cells(i + 1, 2) Then
            Cells(i + 1, 1).Resize(6, 1).EntireRow.Insert
            Cells(i + 1, 1).Resize(6, 2).Value = Cells(i, 1).Resize(1, 2).Value
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Thanks in advance

[Olly]

Try:

Sub foo()
    Dim wsInput As Worksheet
    Dim wsOutput As Worksheet
    Dim lInRow As Long
    Dim lInCol As Long
    Dim sItem As String
    Dim dtModeOpen As Date
    
    On Error GoTo Terminate
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Set wsInput = Worksheets("SQL export")
    Set wsOutput = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    
    wsOutput.Range("A1:F1") = Array("Concatenate", "Expr2", "Weekday", "Open", "Close", "BDH")
    
    lInRow = 2
    
    With wsInput
        Do Until IsEmpty(.Cells(lInRow, 1))
            sItem = .Cells(lInRow, 1).Value
            dtModeOpen = RealTime(Application.WorksheetFunction.Mode(.Cells(lInRow, 2).Resize(1, 7)))
            For lInCol = 1 To 7
                With wsOutput.Cells(Rows.Count, 1).End(xlUp)
                    .Offset(1, 0).Value = sItem & lInCol
                    .Offset(1, 1).Value = sItem
                    .Offset(1, 2).Value = lInCol
                    With .Offset(1, 3)
                        .Value = RealTime(wsInput.Cells(lInRow, 1 + lInCol).Value)
                        .NumberFormat = "h:mm:ss"
                    End With
                    With .Offset(1, 4)
                        .Value = RealTime(wsInput.Cells(lInRow, 8 + lInCol).Value)
                        .NumberFormat = "h:mm:ss"
                    End With
                    If .Offset(1, 3).Value <> dtModeOpen And .Offset(1, 3).Value <> 0 Then
                        .Offset(1, 5).Value = "BDH"
                    End If
                End With
            Next lInCol
            lInRow = lInRow + 1
        Loop
    End With
    
Terminate:
    If Err Then
        Debug.Print "ERROR", Err.Number, Err.Description
        Err.Clear
    End If
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


Function RealTime(ByVal Minutes As Long)
    RealTime = Minutes / 60 / 24
End Function

That will add a new worksheet, containing your required output.

[mike7952]

Another solution

Sub abc()
 Dim arrOut, i As Long, ii As Long, iii As Long
 
 
 With Worksheets("SQL export")
    ReDim arrOut(1 To (.Cells(Rows.Count, "a").End(xlUp).Row - 1) * 7, 1 To 5)
    For i = 2 To .Cells(Rows.Count, "a").End(xlUp).Row
        For ii = 1 To 7
            iii = iii + 1
            arrOut(iii, 1) = .Cells(i, 1) & ii
            arrOut(iii, 2) = .Cells(i, 1)
            arrOut(iii, 3) = ii
            arrOut(iii, 4) = VBA.Format(.Cells(i, 1 + ii) / 60 / 24, "h:mm AM/PM")
            arrOut(iii, 5) = VBA.Format(.Cells(i, 8 + ii) / 60 / 24, "h:mm AM/PM")
        Next
    Next
 End With
 With Worksheets("Desired output")
    .Cells(1).Resize(, 6) = Array("Concatenate", "Expr2", "Weekday", "Open", "Close", "BDH [?]")
    .Cells(2, 1).Resize(UBound(arrOut), 5) = arrOut
    With .Cells(2, 6).Resize(UBound(arrOut))
        .Formula = "=IF(C2<6,IF(D2>AVERAGEIFS(D:D,B:B,B2,C:C,""<6""),""BDH"",""""),"""")"
        .Value = .Value
    End With
    .Cells.EntireColumn.AutoFit
 End With
End Sub

[PFDave]

Thank you both for your great solutions. Both fit for purpose and I really do appreciate your help on this.

Thanks again

Dave