Listbox to Excel Sheet

Question

I have here a listbox that is filtered by name of a person. When a name is chosen from a combobox, the listbox is populating correctly. What I would like to achieve is when the listbox is displayed, it should put the time entries in the zeros (see Figure 3).

Figure 1 (Chosen Name 1)

Figure 2 (Chosen Name 2)

Encoded Manually in Excel sheet:

Implementation                 ||  Arizona || New York  || Louisiana|| Michigan
Total Hours Worked (hh:mm:ss)  ||     0    ||    0      ||    0     ||    0
Average Hours (hh:mm:ss)       ||     0    ||    0      ||    0     ||    0

Figure 3

This is my desired output for Chosen Name 1:

This is my desired result for Chosen Name 2:

This is the result I am getting if choosing Name 1.

This is the result I am getting if choosing Name 2.

This is my code for saving the listbox to sheet:

        Dim sh As Worksheet

        Set sh = ThisWorkbook.Sheets("Sheet4")

        Dim n As Long



        For n = 1 To Me.ListBox2.ListCount - 1

        sh.Range("A" & Rows.Count).End(xlUp).ClearContents

        sh.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox2.List(n, 0)

        sh.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox2.List(n, 1)

        sh.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox2.List(n, 2)

       

        Next n

I have here a graph ready code but I will just use it when the code for saving listbox entries to excel is already fixed.

            'Dim CurrentFileName As String

            'CurrentFileName = ThisWorkbook.Path & "\current.gif"

              

            'Dim CurrentChart As Chart

            'Set CurrentChart = ThisWorkbook.Sheets("Sheet4").ChartObjects("Chart 1").Chart

            'CurrentChart.Export Filename:=CurrentFileName, FilterName:="GIF"

              

            'UserForm3.Image1.Picture = LoadPicture(CurrentFileName)

Please tell me where I am getting wrong. TY

Answer 1

Please try.

Option Explicit
Private Sub CommandButton1_Click()
    Dim sh As Worksheet, c As Range
    Dim n As Long
    Set sh = ThisWorkbook.Sheets("Sheet4")
    With Me.ListBox2
        For n = 1 To .ListCount - 1
            ' Locate "Implementation" in the first row
            Set c = sh.Range("1:1").Find(.List(n, 0), , xlValues, xlWhole)
            If Not c Is Nothing Then
                ' Populate Hours
                c.Offset(1, 0).Value = .List(n, 1)
                c.Offset(2, 0).Value = .List(n, 2)
            End If
        Next n
    End With
End Sub

---

Reset the output result range.

    With Sheets("Sheet6").UsedRange
        .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Value = 0
    End With