PDA

View Full Version : Loop through specific range of dates do something and then do it again for new date r



thebradman18
09-29-2016, 10:22 AM
I am trying to loop through a range of dates in one spreadsheet and the do it again for different ranges of date within the same spreadsheet. I am thinking it is a simple do loop but need some help
Here is my code I have that is working for one date range in the worksheet:

Sub alex()
Dim iRow, iCol, r As Integer
Dim undrly_sub_type As String
Dim Last_Row As Long, n As Long
Dim Startdate

ActiveWorkbook.Sheets("CHANNEL REPORT").Activate


iCol = 3
Last_Row = Range("c2").End(xlDown).Row
For iRow = 2 To Last_Row
If iRow = 2 Then
undrly_sub_type = Cells(iRow, iCol).Text
Else
undrly_sub_type = undrly_sub_type & " , " & Cells(iRow, iCol).Text
End If
Next iRow


Sheets("DAILY REPORT").Select
Cells(9, 9).Clear

Cells(9, 9) = undrly_sub_type
Call Dups


End Sub

here is the spreadsheet data:



CreatedBy
LocationName
LocationID
State
Region
District
W.O.#
P.O.#
Tr.#
NTE
CallDate


RTP0580
South Orange Blossom Trail
580
FL
NEF
EFL 2
74458149
74458149
74458149
300.00
9/19/16


bdellapenna
Edgewater
658
FL
NEF
EFL 4
74466549
74466549
74466549
300.00
9/19/16


RTP0162
Millenia
162
FL
NWF
EFL 2
74466912
74466912
74466912
300.00
9/19/16


bdellapenna
Central Florida Pkwy
586
FL
NWF
EFL 5
74470385
74470385
74470385
0.00
9/19/16


bdellapenna
South John Young Pkwy.
570
FL
NEF
EFL 2
74470485
74470485
74470485
300.00
9/19/16


bdellapenna
South John Young Pkwy.
570
FL
NEF
EFL 2
74471801
74471801
74471801
300.00
9/19/16


bdellapenna
Winegard
2363
FL
NWF
EFL 5
74479579
74479579
74479579
300.00
9/19/16


RTP0637
South Semoran Blvd.
637
FL
NEF
EFL 2
74485132
74485132
74485132
400.00
9/19/16


RTP0586
Central Florida Pkwy
586
FL
NWF
EFL 5
74490532
74490532
74490532
300.00
9/20/16


RTP0637
South Semoran Blvd.
637
FL
NEF
EFL 2
74503255
74503255
74503255
300.00
9/20/16


RTP0637
South Semoran Blvd.
637
FL
NEF
EFL 2
74503342
74503342
74503342
300.00
9/20/16


RTP0637
South Semoran Blvd.
637
FL
NEF
EFL 2
74503450
74503450
74503450
300.00
9/20/16


RTP0580
South Orange Blossom Trail
580
FL
NEF
EFL 2
74506150
74506150
74506150
300.00
9/20/16


RTP2363
Winegard
2363
FL
NWF
EFL 5
74523976
74523976
74523976
300.00
9/21/16


RTP2363
Winegard
2363
FL
NWF
EFL 5
74526563
74526563
74526563
300.00
9/21/16


RTP2376
Narcoossee
2376
FL
NWF
EFL 2
74526685
74526685
74526685
0.00
9/21/16


RTP0580
South Orange Blossom Trail
580
FL
NEF
EFL 2
74574589
74574589
74574589
300.00
9/22/16


bdellapenna
South Semoran Blvd.
637
FL
NEF
EFL 2
74575526
74575526
74575526
300.00
9/22/16


bdellapenna
South John Young Pkwy.
570
FL
NEF
EFL 2
74608728
74608728
74608728
300.00
9/23/16


bdellapenna
South John Young Pkwy.
570
FL
NEF
EFL 2
74611110
74611110
74611110
300.00
9/23/16





My code would work if it were just the 9.19.2016 data.
Thank you so much
This shouldn't be that hard to do

mana
09-30-2016, 03:04 AM
Option Explicit

Sub test()
Dim dic As Object
Dim ws1 As Worksheet, ws2 As Worksheet
Dim v
Dim d As Date
Dim i As Long
Dim k, n As Long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

v = ws1.Range("a1").CurrentRegion.Value

Set dic = CreateObject("scripting.dictionary")

For i = 2 To UBound(v)
d = v(i, 11)
If Not dic.exists(d) Then
Set dic(d) = CreateObject("system.collections.arraylist")
End If
dic(d).Add v(i, 3)
Next

ws2.Columns(9).Resize(Rows.Count - 8).Offset(8).ClearContents

For Each k In dic.keys
ws2.Range("i9").Offset(n).Value = Join(dic(k).toarray, " , ")
n = n + 1
Next

End Sub

mana
09-30-2016, 03:31 AM
Option Explicit


Sub alex()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim iRow, iCol, r As Integer
Dim undrly_sub_type As String
Dim Last_Row As Long, n As Long
Dim Startdate As Boolean

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

ws2.Columns(9).Resize(Rows.Count - 8).Offset(8).ClearContents

With ws1
iCol = 3
Last_Row = .Cells(2, 3).End(xlDown).Row
Startdate = True

For iRow = 2 To Last_Row
If Startdate Then
undrly_sub_type = .Cells(iRow, iCol).Text
Startdate = False
Else
undrly_sub_type = undrly_sub_type & " , " & .Cells(iRow, iCol).Text
End If
If .Cells(iRow, 11).Value2 <> .Cells(iRow + 1, 11).Value2 Then
ws2.Cells(9, 9).Offset(n).Value = undrly_sub_type
undrly_sub_type = ""
Startdate = True
n = n + 1
End If
Next iRow
End With


End Sub

thebradman18
09-30-2016, 05:31 AM
Option Explicit


Sub alex()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim iRow, iCol, r As Integer
Dim undrly_sub_type As String
Dim Last_Row As Long, n As Long
Dim Startdate As Boolean

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

ws2.Columns(9).Resize(Rows.Count - 8).Offset(8).ClearContents

With ws1
iCol = 3
Last_Row = .Cells(2, 3).End(xlDown).Row
Startdate = True

For iRow = 2 To Last_Row
If Startdate Then
undrly_sub_type = .Cells(iRow, iCol).Text
Startdate = False
Else
undrly_sub_type = undrly_sub_type & " , " & .Cells(iRow, iCol).Text
End If
If .Cells(iRow, 11).Value2 <> .Cells(iRow + 1, 11).Value2 Then
ws2.Cells(9, 9).Offset(n).Value = undrly_sub_type
undrly_sub_type = ""
Startdate = True
n = n + 1
End If
Next iRow
End With


End Sub