Excel VBA - Triple Nested Loop to tie column keys together - vba

Question

I'm trying to set up a nested loop that can tie together different columns only when the column in question has data.
What I have is a table like this:
|Aname |aterm |amod |
| | | |
|Smith, Bob | | |
| | | |
| | | |
| | 2/6/2017| |
| | | |
| | |Module 1 |
| | | |
|Smith, John | | |
| | | |
| | | |
| |5/12/2017| |
| | |Module 6 |
| | | |
| | |Module 4 |
| | | |
| |6/12/2017| |
| | | |
| | |Module 10|
| | |Module 5 |
What I am trying to do is tie the columns together like so:
|aname |aterm |amod |
|Smith, Bob | 02/6/2017 | Module 1 |
|Smith, John | 5/12/2014 | Module 6 |
|Smith, John | 5/12/2014 | Module 4 |
|Smith, John | 6/12/2014 | Module 10 |
|Smith, John | 6/12/2014 | Module 5 |
Below is the code I put together to pull this off. Unfortunately, the printing is picking up the aname dozens of time, the aterm intermittently, and the amod not at all.
Sub looper()
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
aname = ""
aterm = ""
amod = ""
Set listenroll = [table1[aname]]
Set atermrange = [table1[aterm]]
Set amodrange = [table1[amod]]
For Each rng In listenroll
If IsEmpty(rng) = False Then
Set aname = rng
For Each rng2 In atermrange
If IsEmpty(rng2) = False Then
Set aterm = rng2
For Each rng3 In amodrange
If IsEmpty(rng3) = False Then
Set amodrange = rng3
Range("I1").End(xlDown).Offset(1, 0) = aname
Range("J1").End(xlDown).Offset(1, 0) = aterm
Range("K1").End(xlDown).Offset(1, 0) = amod
End If
Next rng3
End If
Next rng2
End If
Next rng
Does anyone know what the problem is here?

Answer 1

I have an alternative solution for you. This is basically the same thing with YowE3K's code, however there is one more for loop and one less if statement. This is because, instead of using table names I used column A B C assuming your table is there, and also stored the values in an array.
Try this:
Sub looper()
Dim i As Long, j As Long, LastCell As Long
Dim arr() As String
ReDim arr(2)
With Sheets("Sheet1")
LastCell = .UsedRange.Rows.Count
For i = 2 To LastCell
For j = 1 To 3
If Not IsEmpty(.Cells(i, j)) Then
arr(j - 1) = .Cells(i, j)
If j = 3 Then
.Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0) = arr(0)
.Cells(.Rows.Count, "J").End(xlUp).Offset(1, 0) = arr(1)
.Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0) = arr(2)
End If
End If
Next j
Next i
End With
End Sub

Answer 2

You only need one loop:
Sub looper()
Dim aname As String
'Dim aterm As String
Dim aterm As Date
Dim amod As String
aname = ""
'aterm = ""
aterm = 0
amod = ""
Set listenroll = [table1[aname]]
Set atermrange = [table1[aterm]]
Set amodrange = [table1[amod]]
Dim r As Long
For r = 1 to amodrange.Rows.Count
'Record value of AName whenever it changes
If Trim(listenroll(r, 1).Value) <> vbNullString Then
aname = Trim(listenroll(r, 1).Value)
End If
'Record value of ATerm whenever it changes
If Trim(atermrange(r, 1).Value) <> vbNullString Then
'aterm = Trim(atermrange(r, 1).Value)
aterm = CDate(atermrange(r, 1).Value)
End If
'Write output each time there is something in amod
If Trim(amodrange(r, 1).Value) <> vbNullString Then
amod = Trim(amodrange(r, 1).Value)
Range("I1").End(xlDown).Offset(1, 0) = aname
Range("J1").End(xlDown).Offset(1, 0) = aterm
Range("K1").End(xlDown).Offset(1, 0) = amod
End If
Next
Note: I'm not sure how to modify aterm to match your question's example, but I'm hoping that's just a typo in the example.
And, FWIW, you have one major error in your existing code at the point where you say Set amodrange = rng3. I'm not sure whether that is the only error.