Assalamualaikum.

Dear Teman-Teman Be-Exceller,

Saya ada kendala di panjangnya script berikut,
nah rencana saya mau looping untuk bagian berwarna biru.

Mohon bantuan idenya.

Berikut Scriptnya :

'credit to Slamet <[email protected]> @ [email protected]
'Adjustment Heri Pamungkas

Private Sub UserForm_Initialize()
Dim rDates As Range
Dim x As Variant
Dim y As Variant
Dim z As Variant

With Sheet3
    Set rDates = .Range(.Cells(11, 7), .Cells(.Rows.Count, 7).End(xlUp))
End With
    y = "Date             Supplier -> No. Document"
    ListBox1.AddItem y
    ListBox2.AddItem y
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A1").Select

'Dokumen Sudah Expired
For Each cl In rDates
    Select Case cl.Value
    Case Is = Date
x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " & Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
    ListBox1.AddItem x
    cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 7
    End Select
Next cl

'Dokumen Akan Expired +7
For Each cl In rDates
    Select Case cl.Value
*Case Is = Date + 1*
x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " & Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
    ListBox2.AddItem x
    cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
    End Select
Next cl
For Each cl In rDates
    Select Case cl.Value
*Case Is = Date + 2*
x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " & Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
    ListBox2.AddItem x
    cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
    End Select
Next cl
For Each cl In rDates
    Select Case cl.Value
*Case Is = Date + 3*
x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " & Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
    ListBox2.AddItem x
    cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
    End Select
Next cl
For Each cl In rDates
    Select Case cl.Value
*Case Is = Date + 4*
x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " & Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
    ListBox2.AddItem x
    cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
    End Select
Next cl
For Each cl In rDates
    Select Case cl.Value
*Case Is = Date + 5*
x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " & Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
    ListBox2.AddItem x
    cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
    End Select
Next cl
For Each cl In rDates
    Select Case cl.Value
*Case Is = Date + 6*
x = Format(cl.Offset(0, 0).Value, "dd-mmm-yy") & " " & Format(cl.Offset(0, -3).Value, "") & " -> " & cl.Offset(0, -1)
    ListBox2.AddItem x
    cl.Offset(0, -4).Resize(, 5).Interior.ColorIndex = 6
    End Select
Next cl
End Sub



???????????? ?????????? ?????????? ????? ?????????????

Warm Regards,

Kirim email ke