user2237168
user2237168

Reputation: 303

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

I have the following in my OptieRestricties tab in Excel:

enter image description here

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:

enter image description here

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:

enter image description here

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.

Upvotes: 3

Views: 281

Answers (1)

paul bica
paul bica

Reputation: 10715

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

sample

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

Upvotes: 1

Related Questions