[SOLVED] Stop executing loop when first blank cell is encountered

Stop executing loop when first blank cell is encountered

We have a workbook where data from completed invoices is copied into column C of Sheet1 every period.

Column A is for the Year and Column B is for the financial period (we run 13 periods per year).

This formula is in column B of Sheet1. It checks if column C has anything in it and if so displays the current period from a cell in Sheet2.

=IF(C93<>"",Sheet2!$L$3,"")

This requires the cells to have the period information copied and re-pasted as values before the period changes over to the next one.

For this latest version on Sheet2 we have a table with the 13 periods in column Q and column P indicates if that period is closed.

I found code online and adapted it. It finds the first empty cell in Column B of Sheet1 and then checks Sheet2 and pastes the value of the cell in Column Q that has an empty cell beside it in Column P.

Sub GetPeriod()
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    x = Range("A2:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    x = srcWS.Range("P2:P" & srcWS.Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    With desWS
        .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = srcWS.Range("Q" & x)
    End With
End Sub

It works, however I want to make it loop and then stop when it reaches the last of the pasted data in column C of Sheet1.

I tried Do While on line 6, it didn't stop at an empty cell in column C and ran down the sheet adding the period number.

Sub GetPeriod()
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    x = Range("A2:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    Do While desWS.Range("C" & x) <> ""
    x = srcWS.Range("P2:P" & srcWS.Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    With desWS
        .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = srcWS.Range("Q" & x)
    End With
    
    Loop
End Sub

Solution

The code examines the cells in Column B starting from START_ROW. If it finds a non-blank cell, it copies the corresponding cell from Column Q to sheet1.
If this isn't the outcome you expected, please edit your post to include sample data and provide more details about the desired output.

Sub GetPeriod()
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    Const START_ROW = 2 ' the first data row# on Sheet2, modify as needed
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    x = START_ROW
    Do While Len(desWS.Range("C" & x)) > 0
        With desWS
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = srcWS.Range("Q" & x)
        End With
        x = x + 1
    Loop
End Sub