1 Message

Digest #3973

Bantuan Looping by "Heri Pamungkas ( Gmail )" dchoosen88

Message

1 Bantuan Looping

Fri Sep 23, 2016 12:22 am (PDT) . Posted by:

"Heri Pamungkas ( Gmail )" dchoosen88

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 <slametharto@gmail.com> @ belajar-excel@yahoogroups.com
'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,

Reply to sender . Reply to group . Reply via Web Post . All Messages (1) . Top ^

============================================================
Pojok Lowongan Kerja yang disediakan milis :
http://milis-belajar-excel.1048464.n5.nabble.com/Pojok-Lowongan-Kerja-f5725753.html
*** Posting lowongan kerja : ke link tersebut dan klik New Topic
============================================================
bergabung ke milis (subscribe), kirim mail kosong ke: belajar-excel-subscribe@yahoogroups.com
posting ke milis, kirimkan ke: belajar-excel@yahoogroups.com
berkunjung ke web milis : http://tech.groups.yahoo.com/group/belajar-excel/messages
melihat file archive / mendownload lampiran : http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di : http://milis-belajar-excel.1048464.n5.nabble.com/
menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com
keluar dari membership milis (UnSubscribe), kirim mail kosong ke : belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------

Visit Your Group