VBA loop code until cell is empty in a column-CodePudding

Trying to do a code loop until the last cell in column A .

Tried to do it with For but did not understand something and tried a Do Until. It kinda worked but it gets stuck after Pasting details code.

My code is bellow does anyone knows why it gets stuck ?

Sub Pivot()
    Dim lastrow_blank As Long
    Dim lastrow_blankA As Long
    Dim lastrow_blankselection As Long
    Dim a As Long
    
    Sheets("Report").Select ' Select sheet '
    
    ThisWorkbook.RefreshAll ' Refresh Pivot '

    Data = Date - 1 ' Yesterdays date '
    
    lastrow_blank = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row   1 ' first blank cell in column B '
    lastrow_blankA = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row   1 ' first blank cell in column A '
    lastrow_blankselection = CDate(Cells(lastrow_blank, 1).Value) ' Value selection of the last low in column A '
    
    a = Range("A2").Value
    
    Range("A3:A" & CLng(Date - a   1)).Value = Evaluate("Row(" & a   1 & ":" & CLng(Date) & ")") ' Paste date's until yesterday in column A '

    Do Until IsEmpty(Cells(lastrow_blank, 1)) ' loop starts '
        If Cells(lastrow_blank, 1) = "" Then ' If first cell in column B is empty then '
            MsgBox "Info" ' Message if cell is empty '
            Exit Sub
        Else
            ActiveWorkbook.SlicerCaches("NativeTimeline_Value_Date").TimelineState. _
            SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
            ActiveWorkbook.SlicerCaches("NativeTimeline_Good_Date").TimelineState. _
            SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
            
            Sheets("Report").Range("O4:Z4").Copy ' Copy cells that returns details from Pivot '
    
            Cells(lastrow_blank, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False ' Paste details from Pivot to celected cells'
            
            ' when the code is launched it loops first time correctly and then after the paste code it gets stuck i think because it does nothing'
            ' After I cancel the code paste code get highlited in yellow '
        End If
    Loop
End Sub

CodePudding user response：

Your loop is permanently checking lastrow's cell value, but you want to check each cell on every run. As mentioned in comments, you have to increment something. That something is called iterator, so you have to:

declare some variable as integer/ long
add 1 to it's value on every run of the loop
You also should correct condition of your loop:

Do Until IsEmpty(Cells(lastrow_blank, 1)) ' loop starts '

In the result you should end up with something like this

[...]
dim Iterator as Integer
Iterator = 1

`Do Until IsEmpty(Cells(Iterator, 1)) ' loop starts '`
[...]
Iterator = Iterator   1 'Incrementation
loop

It's up to you when you increment iterator's value, it depends on the construction of given loop. If condition is on the beginning of the loop (do until ; as in your case) then you usually may want to increment on the very end of the loop so that in next run the condition will be checked.

Hope it helped you!

CodePudding user response：

Finished deal.

Thanks @kamikadze366

Sub Datos_nustatymas()

Dim lastrow_blank As Long
Dim lastrow_blankA As Long
Dim lastrow_blankselection As Long
Dim a As Long

Sheets("Report").Select ' Select sheet '

ThisWorkbook.RefreshAll ' Refresh Pivot '

Data = Date - 1 ' Yesterdays date '

lastrow_blankA = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row   1 ' first blank cell in column A '
lastrow_blank = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row   1 ' first blank cell in column B '

a = Range("A2").Value
Range("A3:A" & CLng(Date - a   1)).Value = Evaluate("Row(" & a   1 & ":" & CLng(Date) & ")") ' Paste date's until yesterday in column A '

Do Until IsEmpty(Cells(lastrow_blank, 1))

lastrow_blankselection = CDate(Cells(lastrow_blank, 1).Value) ' Value selection of the last low in column A '

If Cells(lastrow_blank, 1) = "" Then ' If first cell in column B is empty then '
MsgBox "Info" ' Message if cell is empty '
Exit Sub
    Else
ActiveWorkbook.SlicerCaches("NativeTimeline_Value_Date").TimelineState. _
        SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
    ActiveWorkbook.SlicerCaches("NativeTimeline_Good_Date").TimelineState. _
        SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
        
Sheets("Report").Range("O4:Z4").Copy ' Copy cells that returns details from Pivot '

Cells(lastrow_blank, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False ' Paste details from Pivot to celected cells'
        
        ' when the code is launched it loops first time correctly and then after the paste code it gets stuck i think because it does nothing'
        ' After I cancel the code paste code get highlited in yellow '
          End If
        lastrow_blank = lastrow_blank   1
       Loop
End Sub