Start Do Until loop when a value in a column cell is found and end when empty column cell is found

Question

I have the following in my OptieRestricties tab in Excel:

I have the following VBA code:

Private Sub CommandButton_Click()

Dim i                 As Long
Dim p                 As Long
Dim Item              As String
Dim ifcond            As String
Dim thencond          As String

Excel.Worksheets("OptieRestricties").Select

    With ActiveSheet
        i = 2
        Do Until IsEmpty(.Cells(i, 2))
        p = 4
            Do Until IsEmpty(.Cells(2, p))
                ifcond = ActiveSheet.Cells(i, 2)
                thencond = ActiveSheet.Cells(i, 3)
                Item = ActiveSheet.Cells(i, p)

                If Not IsEmpty(Item) Then
                    Debug.Print Item & " --- " & ifcond & " " & thencond
                End If
                p = p + 1
            Loop
            i = i + 1
        Loop

    End With
  End Sub

The code returns the following result:

Kraker_child_1 --- [775](16).value=0 [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;

However, how can the code be modified such that it returns the following? (note that I want to be able to add items in columns that come after E as well (e.g in f, g, h etc.)):

Kraker_child_1 --- [775](16).value=1 [775](12,13,14,15,17,18,19).visible=1 
Kraker_child_1 --- [775](16).value=0 [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;
Kraker_child_1 --- [775](16).value=0 [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;

Update

The output that I am getting after applying the code from Paul with the following excel structure:

Yields the following output:

 child_3 ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child_2 ---> [775](16).value=0 >>> [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;

While it should return:

 child ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child_3 ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child_2 ---> [775](16).value=0 >>> [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;

Update 2

When applying the latest code from Paul to more rows, in my case 111 rows:

the code should print 223 rows in the following format:

 child ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 childa ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child_b ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child ---> [775](16).value=0 >>> [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;
 childa ---> [775](16).value=0 >>> [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0; 
 .....

However, only 174 rows are printed. So 49 rows are not printed.

paul bica · Accepted Answer · 2018-01-18T11:17:18.790

I would start by determining the last row in the used range

Then, for each row:

Find the last used column
Iterate through all non empty items between col D and last used column

Option Explicit

Public Sub ShowConditions()
    Const COL_IF = 2
    Const COL_THEN = 3

    Dim lRow As Long, lCol As Long, r As Long, colItm As Long
    Dim itm As String, ifCond As String, thenCond As String

    With ThisWorkbook.Worksheets("OptieRestricties")
        lRow = .Cells(.Rows.Count, COL_IF).End(xlUp).Row            'last used row
        For r = 2 To lRow
            lCol = .Cells(r, .Columns.Count).End(xlToLeft).Column   'last used column
            If lCol > COL_THEN Then
                colItm = COL_THEN + 1
                ifCond = .Cells(r, COL_IF).Value2
                thenCond = .Cells(r, COL_THEN).Value2
                Do While colItm <= lCol
                    itm = .Cells(r, colItm).Value2
                    If Len(itm) > 0 Then
                        Debug.Print itm & " ---> " & ifCond & " >>> " & thenCond
                    End If
                    colItm = colItm + 1
                Loop
            End If
        Next
    End With
End Sub

So for this example

you get

G2 ---> If B2 >>> Then C2
 D3 ---> If B3 >>> Then C3
 E3 ---> If B3 >>> Then C3
 F3 ---> If B3 >>> Then C3
 G3 ---> If B3 >>> Then C3
 H3 ---> If B3 >>> Then C3
H4 ---> If B4 >>> Then C4
 E5 ---> If B5 >>> Then C5
 H5 ---> If B5 >>> Then C5
D7 ---> If B7 >>> Then C7
F7 ---> If B7 >>> Then C7
G7 ---> If B7 >>> Then C7
H7 ---> If B7 >>> Then C7

Output to file

This is how to write the output to an external text file, instead of the Immediate Window:

Public Sub ShowConditions()
    Const WS_NAME = "OptieRestricties"
    Const COL_IF = 2
    Const COL_THEN = 3

    Dim lRow As Long, lCol As Long, r As Long, itmCol As Long
    Dim itm As String, ifVal As String, thenVal As String, res As String

    With ThisWorkbook.Worksheets(WS_NAME)
        lRow = .Cells(.Rows.Count, COL_IF).End(xlUp).Row            'last used row
        For r = 2 To lRow
            lCol = .Cells(r, .Columns.Count).End(xlToLeft).Column   'last used column
            If lCol > COL_THEN Then
                itmCol = COL_THEN + 1
                ifVal = .Cells(r, COL_IF).Value2
                thenVal = .Cells(r, COL_THEN).Value2
                Do While itmCol <= lCol
                    itm = .Cells(r, itmCol).Value2
                    If Len(itm) > 0 Then
                        res = res & itm & " ---> " & ifVal & " >>> " & thenVal & vbCrLf
                    End If
                    itmCol = itmCol + 1
                Loop
            End If
        Next
    End With

    Dim outFileID As Long

    outFileID = FreeFile  'get next available file handle from the OS

    Open ThisWorkbook.Path & "\otput.txt" For Output As #outFileID  'open file handle
    Print #outFileID, Left(res, Len(res) - 2)                       'print to file
    Close #outFileID                                                'close file handle
End Sub

This will generate a new file named otput.txt in the same folder as the current file

Hi Paul. Thanks for your answer. However, I have still one question. How can we adjust your code such that not only one item is printed but all items beyond row 3 that are in the same row as the if and then statements (please take a look at my first post. I updated my first post with an example of the aforementioned)? — user2237168, Jan 17 '18 at 07:12
Hi Paul. Once again thanks for your great support. However, there is still one little issue. If all of the items are filled out, the code only returns the last item, while it should also return the items that are in front of the last item. Please take a look at my first post for the example output that I am now getting after using your latest code. — user2237168, Jan 17 '18 at 12:57
Thanks for the feedback - I removed the dynamic start column (all columns are checked now). Let me know if there are any other issues — paul bica, Jan 17 '18 at 14:21
Hi Paul. Well there is still one thing that prevents the code from giving the desired result. When I apply it to a large set of data some rows are not printed. Does this occur due to function restrictions? You can look at my first post under update2 where I explain the issue more in detail. — user2237168, Jan 17 '18 at 15:56
I'm not sure why you only get 174 rows printed - the Immediate Window will display the last 200 lines generated by the Debug.Print statement. Regardless, you will not get all 223 that you expect. The Immediate Window is normally used for debugging purposes, mainly to verify that the code works as expected. If you need to generate more text you can [send the output to an external file](https://stackoverflow.com/questions/11503174/how-to-create-and-write-to-a-txt-file-using-vba). Do you need the output for something specific? — paul bica, Jan 17 '18 at 20:35
Hi Paul. Eventually I would like to enter the if and then rules an items into a SQL server database. I see that the output text file gives the desired amount of rows and I also noticed that the desired amount of rows are inserted into the database (I refactored your code a bit and replaced the 'open file' line with and INSERT Into line). I do not know why the debug screen was showing something different. Anyhow, my question is solved by your solution :). I really appreciate your support and I am glad that the data is inserted properly into the database. Thanks Paul! — user2237168, Jan 18 '18 at 07:13

Start Do Until loop when a value in a column cell is found and end when empty column cell is found

1 Answers1