Fylde listebox med range 2 - til Bak

Måske skulle jeg lige smide hele koden:

Private Sub UserForm_Activate()

Dim Data(), DataList(), tmpData As Variant, intNbrRow
Dim i As Integer, line, k As Integer
Dim intQuot As Integer, intCustNbr As Integer, intCustName As Integer
Dim intCustAdr As Integer, intOrder As Integer, intOrderSend As Integer
   
    intNbrRow = getRow("strDataLokal", "R")
    intOrder = getRow("strDataOrdrenr", "C")
    intQuot = getRow("strDATATilbudsNr", "C")
    intCustNbr = getRow("strDATACustomerNr", "C")
    intCustName = getRow("strDATACustomerName", "C")
    intCustAdr = getRow("strDATACustomerAdr", "C")
    intOrderSend = getRow("strDATAOrderSend", "C")
    ReDim tmpData(1 To 4, 1 To intNbrRow)

    Data = funcRng("strLocalVer", "strWBLocal", "strWSDataLink", "strDataLokal")
    If ufSendOrdre.opbNotSend = False And ufSendOrdre.opbSend = False Then
        ufSendOrdre.opbNotSend = True
    End If
    k = 1
    If ufSendOrdre.opbNotSend = True Then
        For i = 2 To UBound(Data)
            If Data(i, intOrder) <> "" And Data(i, intOrderSend) = "" Then
                tmpData(1, k) = Data(i, intOrder)
                tmpData(2, k) = Data(i, intCustNbr)
                tmpData(3, k) = Data(i, intCustName)
                tmpData(4, k) = Data(i, intCustAdr)
                k = k + 1
            End If
        Next i
    ElseIf ufSendOrdre.opbSend = True Then
        For i = 2 To UBound(Data)
            If Data(i, intOrder) <> "" And Data(i, intOrderSend) <> "" Then
                tmpData(1, k) = Data(i, intOrder)
                tmpData(2, k) = Data(i, intCustNbr)
                tmpData(3, k) = Data(i, intCustName)
                tmpData(4, k) = Data(i, intCustAdr)
                k = k + 1
            End If
        Next i
    End If
        ReDim Preserve tmpData(1 To 4, 1 To k - 1)
        tmpData = Application.WorksheetFunction.Transpose(tmpData)
        With ListBox1
            .ColumnCount = 4
            .ColumnWidths = "50;50;100;150"
            .list = tmpData
        End With

        Set tmpData = Nothing

End Sub

Ajjjj... det er klart - den kan jo ikke transponerer når der kun er en post - så altså når jeg kun har en post er jeg vel nød til at leve med at der bliver en tom post??

Hvis jeg erstatter denne:

      ReDim Preserve tmpData(1 To 4, 1 To k - 1)
med dette så virker det

        If k > 2 Then
            ReDim Preserve tmpData(1 To 4, 1 To k - 1)
        Else
            ReDim Preserve tmpData(1 To 4, 1 To 2)
        End If

Men hører gerne efter en bedre løsning

dette burde også kunne gøre det. :-)

k = 0
    If ufSendOrdre.opbNotSend = True Then
        For i = 2 To UBound(Data)
            If Data(i, intOrder) <> "" And Data(i, intOrderSend) = "" Then
            k = k + 1
                tmpData(1, k) = Data(i, intOrder)
                tmpData(2, k) = Data(i, intCustNbr)
                tmpData(3, k) = Data(i, intCustName)
                tmpData(4, k) = Data(i, intCustAdr)
               
            End If
        Next i
    ElseIf ufSendOrdre.opbSend = True Then
        For i = 2 To UBound(Data)
            If Data(i, intOrder) <> "" And Data(i, intOrderSend) <> "" Then
              k = k + 1
                tmpData(1, k) = Data(i, intOrder)
                tmpData(2, k) = Data(i, intCustNbr)
                tmpData(3, k) = Data(i, intCustName)
                tmpData(4, k) = Data(i, intCustAdr)
             
            End If
        Next i
    End If
        If k > 0 Then
            ReDim Preserve tmpData(1 To 4, 1 To k)
            tmpData = Application.WorksheetFunction.Transpose(tmpData)
        End If

nej fordi hvis k=1 så laver den ikke et flere dim. array... så bliver tmpdata bare 1 to 4 ..... er det ikke rigtigt - ??

Jeg er vist nød til at have en tom

Har du prøvet ....?

lukker