Reputation: 303
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.
Upvotes: 3
Views: 281
Reputation: 10715
I would start by determining the last row in the used range
Then, for each row:
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
Upvotes: 1