excelloopsconditional-statementsweekdayvba6

vba excel-loop through set of Data, populate depending the Date and skip weekends


I'm having an issue trying to integrate a condition inside a Loop. This condition populates the first 5 cells in a Row (Weekdays) and then skips the next 2 (the Weekend). This goes on depending on the number of the Days. This happens while reading a various number of rows, with different Days, Values and Start Dates (outer loop? ) The Data should be populated depending on said Start Date. To solve thi,s I compare the difference in Start Dates from the current data with the previous one, getting the difference in number of Days. Then offset the new Data for those Days in the columns. Loop all Rows and Read Start My issue is getting to skip the 6th and 7th column/value part. Thanks in advance. I tried a related Solution posted from "karma" which works for one single row. But get some errors when trying to loop through all the data (reading all my Data). The error in this case, only one Row gets populated until the very last Column in Excel, ignoring the number of Days as condition, and not itirating through the next rows. And there I'd still need to populate the information depending on the Start Date. error-1 error-2 error-3

For the first Code missing the skip part :

Sub xt4_LoopDate()
Dim ii1, jj1, osi1, osj1 As Integer
Dim in1Days As Integer, in2Value As Integer
Dim xiStart, in3Datum As Date
Dim xiDiff As Long
Dim jbound As Integer
Range("F3:XFD7").ClearContents

osi1 = 2  'Row
osj1 = 5  'Column
jbound = 5  'Upper Bound
xiStart = Range("C3") 'Start Date

For ii1 = 1 To jbound
    in1Days = Range("A" & ii1 + osi1)   'Get Dauer
    in2Value = Range("B" & ii1 + osi1)   'Get Leistung
    in3Datum = Range("C" & ii1 + osi1)   'Get Start
    xiDiff = DateDiff("D", xiStart, in3Datum)  'DifferenceDates

    For jj1 = 1 To in1Days  'Loop the Length
        Cells(ii1 + osi1, jj1 + osj1 + xiDiff) = in2Value
    Next jj1
Next ii1
End Sub

For the Second Code with the Loop Errors, missing the condition to start on a certain date :

Sub LSATURDAY_V1()
Dim in1Days As Integer, in2Value As Integer
Dim osii1, osjj1 As Integer
Dim ii1 As Integer, NumberRows As Integer
Dim i As Integer, f As Integer, s As Integer, oFill As Range

Range("F3:XFD6").ClearContents

osii1 = 2  'Offset Row
osjj1 = 5  'Offset Column
f = 5: s = 2

NumberRows = 2
For ii1 = 1 To NumberRows
    in1Days = Range("A" & ii1 + osii1)
    in2Value = Range("B" & ii1 + osii1)
    Debug.Print "D&L -> "; in1Days & "  "; in2Value

Set oFill = Range("F" & ii1 + osii1)
    Do
        For i = 1 To f
            oFill.Value = in2Value
            Set oFill = oFill.Offset(0, 1)
            'works for one Row -> Range("N3:XFD3")
            If Application.CountA(Range("F" & ii1 & ":XFD" & ii1)) = in1Days Then Exit Sub
        Next i
        Set oFill = oFill.Offset(0, s)
    Loop
Next ii1
End Sub

Solution

  • Again, I'm not sure if I understand you correctly.
    Anyway, the image below is the one I thought as your expected result.

    Before running the sub:
    enter image description here

    After running the sub:
    enter image description here

    Sub test()
    Dim in1Days As Integer, in2Value As Integer, i As Integer, oFill As Range
    Dim dt As Date
    
    With ActiveSheet
    .Range("F3:XFD7").ClearContents
    Set rg = .Range("A3", .Range("A3").End(xlDown))
    End With
    
    i = 6
    Do
        txt = txt & "," & i & "," & i + 1
        i = i + 7
    Loop Until i >= 50
    
    For Each cell In rg
        in1Days = cell.Value
        in2Value = cell.Offset(0, 1).Value
        dt = cell.Offset(0, 2).Value
    
        Set c = ActiveSheet.Rows(2).Find(dt)
        If c Is Nothing Then Exit Sub
    
        Set oFill = Cells(cell.Row, c.Column)
        Set rgCnt = Range(oFill, oFill.End(xlToRight))
        i = c.Offset(-1, 0)
    
        Do
            If InStr(txt, "," & i) = False Then oFill.Value = in2Value
            Set oFill = oFill.Offset(0, 1): i = i + 1
        Loop Until Application.CountA(rgCnt) = in1Days
    Next
    
    End Sub
    

    It set the rg variable as the range where in1Days value are. (column A)

    it use 6 as the first restriction number, then it loop to create all restriction number as txt variable. So after the loop finish, the txt value are the numbers in yellow of row 1.

    Then it loop to each cell in rg, create the needed variable. (in1Days, in2Value and dt)
    It try to find where is the cell in row 2 which has dt value as c variable. If not found it just exit the sub, if found then it create i which value is from c.offset(-1,0), set the oFill as the starting cell to be filled, and set the rgCnt as the range to be countA.

    Then it do-loop, if the i is not instring of the txt, then it put in2Value into oFill. Then it set oFill (0,1) and make the i = i+1. It loop until the countA of rgCnt = in1Days.

    Please note that it will put the in2Value to the "allowed" column if the found date is in the yellow column. For example is in the last data, 8-Apr-2024 is in yellow (cell K1), 9-Apr also yellow (cell L1), so it start to fill the value in M7, the 10-Apr-2024.

    The value in row 2 are dates formatted as dd.m, so it's not a string "03.4", but "3-Apr-2024".

    Step run the code, so you know what happen.


    Another example
    In the data, row 1 blank (so there is no number). Please ignore the number and the yellow color, as it used just to show that the yellow is the week end and the number is the nth day of the week based on the date in row 2.

    enter image description here

    Expected result:
    enter image description here

    if the dt (the looped cell.offset(0,3) value) fall on the 6th or 7th day of the week, then it will start to the next 1st day of the week. In the example image above, the first dt is 7-Apr-2024 falls on the 7th day of the week, so it start to fill on cell K3.

    Sub test2()
    Dim in1Days As Integer, in2Value As Integer, i As Integer, oFill As Range
    Dim dt As Date
    
    With ActiveSheet
    .Range("F3:XFD7").ClearContents
    Set rg = .Range("A3", .Range("A3").End(xlDown))
    End With
    
    For Each cell In rg
        in1Days = cell.Value
        in2Value = cell.Offset(0, 1).Value
        dt = cell.Offset(0, 2).Value
    
        Set c = ActiveSheet.Rows(2).Find(dt)
        If c Is Nothing Then Exit Sub
    
        Set oFill = Cells(cell.Row, c.Column)
        Set rgCnt = Range(oFill, oFill.End(xlToRight))
        i = Weekday(dt, vbMonday)
    
        Do
            If i < 6 Then oFill.Value = in2Value
            Set oFill = oFill.Offset(0, 1)
            If i = 7 Then i = 1 Else i = i + 1
        Loop Until Application.CountA(rgCnt) = in1Days
    Next
    
    End Sub
    

    The skipping cell take place by using weekday funtion of the looped cell.offset(0,2) value, the dt variable. So the i will be the nth day of the week from the given date.

    In the loop, as long as i < 6 it will write to oFill.
    Then it offset 0,1 the oFill, and if i = 7 it reset i to 1 else it add i + 1.