CODEWITHSUNDEEP
vbaexcel
Emily Alden
Emily Alden

Reputation: 570

Looping over Visible Range Issue

The function is supposed to loop over a filtered range appending a certain date to the first "i" lines then moving to the next date and repeating.

It is appending everything to the header instead of moving down a row each time.

It is not erroring, just not acting as expected. Where am I going wrong on this? 

 Sub Function()

Dim wsExport As Worksheet
Set wsExport = Workbooks("Export Workbook").Worksheets("Export")

Dim uiStartDate As Variant 'I'm using the prefix ui to be User Input
Dim uiEndDate As Variant
Dim uiCount As Variant
Dim cStartDate As Long 'Converted to date
Dim cEndDate As Long
Dim cCount As Long
Dim iDate As Long 'Counter for the date
Dim i As Long 'Counter for the number of items per day.
Dim j As Long 'Counter for Rows
Dim lRow As Long

lRow = Cells.Find(What:="*", LookAt:=xlPart, _
                LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, MatchCase:=False).Row



'Prompt the user for the start date and end date
'uiStartDate = InputBox("Input the first day of week in the format of 01/20/2018", "Start Date User Input")
'uiEndDate = InputBox("Input the last day of week in the format of 01/25/2018", "End Date User Input")
'uiCount = InputBox("Input the number of items per day.", "Installtion Quantity User Input")
uiStartDate = "1/20/2018" 'This is to speed during testing. Will use the above for actual code
uiEndDate = "1/25/2018"
uiCount = "2"


'Convert to their proper data types. (User inputs have to be variants to begin with)
cStartDate = CDate(uiStartDate)
cEndDate = CDate(uiEndDate)
cCount = CLng(uiCount)

With wsExport.Range("A:AP")
    .AutoFilter Field:=19, Criteria1:=">=" & uiStartDate
End With

iDate = cStartDate
j = 2
i = 1

Do While j <= lRow
DoEvents
If Not wsExport.Rows(j).Hidden Then
    wsExport.Range("S" & j).Value = wsExport.Range("S" & j).Value & "-" & iDate
    i = i + 1
    End If

    If i > cCount Then
        i = 1
        iDate = iDate + 1
    End If

    If iDate > cEndDate Then
        j = lRow + 1
    End If
j = j + 1
Loop



End Sub

Upvotes: 1

Views: 55

Answers (2)

Tim Williams
Tim Williams

Reputation: 166256

Here's a simplified example using a different approach to looping over the table:

EDIT: updated to your actual process of incrementing the date every two rows...

Sub Tester()

    Dim sht As Worksheet, rngTable As Range, rw As Range, r As Long
    Dim sDate, eDate, dt, i As Long

    Set sht = ActiveSheet
    Set rngTable = sht.Range("A1").CurrentRegion

    rngTable.AutoFilter                           'clear any previous filter
    rngTable.AutoFilter field:=4, Criteria1:=">3" 'filter to required rows only

    'some dates...
    sDate = Date
    eDate = Date + 3

    dt = sDate 'set date to add
    i = 0

    For r = 2 To rngTable.Rows.Count
        Set rw = rngTable.Rows(r)
        'is the row visible?
        If Not rw.Hidden Then
            With rw.Cells(2)
                .Value = .Value & " - " & Format(dt, "dd/mm/yyyy")
            End With
            i = i + 1
            If i Mod 2 = 0 Then dt = dt + 1  '<< next date every 2 visible rows
            If dt > eDate Then Exit For      '<< exit if run out of dates
        End If
    Next r

End Sub

Upvotes: 1

Greg Viers
Greg Viers

Reputation: 3523

xlCellTypeVisible does not do what you want when working with an offset from a cell like this. Just use an IF instead:

For i = 1 To cCount
  currentRow = currentCell.Offset(1, 0).Row
  Set currentCell = wsExport.Range("S" & currentRow)
  if currentcell.rowheight > 0 then currentCell.Value = currentCell.Value & "- " & iDate

Next i

Upvotes: 1

Related Questions