I'm trying to create a workbook where a range consisting of 4 columns is selected, and a macro is run to to duplicate information in the second column according to the amount of information input into the other three columns. For example:
[TABLE="width: 500"]
<tbody>[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[TD]I want to turn something like this:[/TD]
[/TR]
</tbody>[/TABLE]
<tbody>
[TD="class: xl68"]8/29/2017[/TD]
[TD="class: xl69, width: 139"]Zachary[/TD]
[TD="class: xl70, width: 184"]Test1[/TD]
[TD="class: xl69, width: 133"]Test1[/TD]
[TD="class: xl71"]8/30/2017[/TD]
[TD="class: xl65, width: 139"]April[/TD]
[TD="class: xl67, width: 184"]Test2[/TD]
[TD="class: xl65, width: 133"]Test2[/TD]
[TD="class: xl71"]8/31/2017[/TD]
[TD="class: xl65, width: 139"]Justin[/TD]
[TD="class: xl67, width: 184"]Test3[/TD]
[TD="class: xl65, width: 133"]Test3[/TD]
</tbody>
Into This:
[TABLE="width: 500"]
<tbody>[TR]
[TD]9/1/17[/TD]
[TD]Zachary[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]Zachary[/TD]
[TD]Test2[/TD]
[TD]Test2[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]Zachary[/TD]
[TD]Test3[/TD]
[TD]Test3[/TD]
[/TR]
[TR]
[TD]9/1/17[/TD]
[TD]April[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]April[/TD]
[TD]Test2[/TD]
[TD]Test2[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]April[/TD]
[TD]Test3[/TD]
[TD]Test3[/TD]
[/TR]
[TR]
[TD]9/1/17[/TD]
[TD]Justin[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]Justin[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]Justin[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
</tbody>[/TABLE]
As of right now using the code provide below, I'm only getting this:
[TABLE="width: 500"]
<tbody>[TR]
[TD]9/1/17[/TD]
[TD]Zachary[/TD]
[TD]9/1/17[/TD]
[TD]9/1/17[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]Zachary[/TD]
[TD]9/2/17[/TD]
[TD]9/2/17[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]Zachary[/TD]
[TD]9/3/17[/TD]
[TD]9/3/17[/TD]
[/TR]
[TR]
[TD]9/1/17[/TD]
[TD]April[/TD]
[TD]9/1/17[/TD]
[TD]9/1/17[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]April[/TD]
[TD]9/2/17[/TD]
[TD]9/2/17[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]April[/TD]
[TD]9/3/17[/TD]
[TD]9/3/17[/TD]
[/TR]
[TR]
[TD]9/1/17[/TD]
[TD]Justin[/TD]
[TD]9/1/17[/TD]
[TD]9/1/17[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]Justin[/TD]
[TD]9/2/17[/TD]
[TD]9/2/17[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]Justin[/TD]
[TD]9/3/17[/TD]
[TD]9/3/17[/TD]
[/TR]
</tbody>[/TABLE]
I've gotten this far because of the following code that someone from here gave me to play with. I have been messing with it and attempting to make it work for what I need because originally it only referenced 2 columns. After I figure this problem out, I'm going to be looking into ways to make it all happen on the same tab. I can probably figure that out myself, but I'm open to input on all things considered.
I appreciate what you guys do here! Thanks any help.
[TABLE="width: 500"]
<tbody>[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[TD]I want to turn something like this:[/TD]
[/TR]
</tbody>[/TABLE]
<tbody>
[TD="class: xl68"]8/29/2017[/TD]
[TD="class: xl69, width: 139"]Zachary[/TD]
[TD="class: xl70, width: 184"]Test1[/TD]
[TD="class: xl69, width: 133"]Test1[/TD]
[TD="class: xl71"]8/30/2017[/TD]
[TD="class: xl65, width: 139"]April[/TD]
[TD="class: xl67, width: 184"]Test2[/TD]
[TD="class: xl65, width: 133"]Test2[/TD]
[TD="class: xl71"]8/31/2017[/TD]
[TD="class: xl65, width: 139"]Justin[/TD]
[TD="class: xl67, width: 184"]Test3[/TD]
[TD="class: xl65, width: 133"]Test3[/TD]
</tbody>
Into This:
[TABLE="width: 500"]
<tbody>[TR]
[TD]9/1/17[/TD]
[TD]Zachary[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]Zachary[/TD]
[TD]Test2[/TD]
[TD]Test2[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]Zachary[/TD]
[TD]Test3[/TD]
[TD]Test3[/TD]
[/TR]
[TR]
[TD]9/1/17[/TD]
[TD]April[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]April[/TD]
[TD]Test2[/TD]
[TD]Test2[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]April[/TD]
[TD]Test3[/TD]
[TD]Test3[/TD]
[/TR]
[TR]
[TD]9/1/17[/TD]
[TD]Justin[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]Justin[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]Justin[/TD]
[TD]Test1[/TD]
[TD]Test1[/TD]
[/TR]
</tbody>[/TABLE]
As of right now using the code provide below, I'm only getting this:
[TABLE="width: 500"]
<tbody>[TR]
[TD]9/1/17[/TD]
[TD]Zachary[/TD]
[TD]9/1/17[/TD]
[TD]9/1/17[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]Zachary[/TD]
[TD]9/2/17[/TD]
[TD]9/2/17[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]Zachary[/TD]
[TD]9/3/17[/TD]
[TD]9/3/17[/TD]
[/TR]
[TR]
[TD]9/1/17[/TD]
[TD]April[/TD]
[TD]9/1/17[/TD]
[TD]9/1/17[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]April[/TD]
[TD]9/2/17[/TD]
[TD]9/2/17[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]April[/TD]
[TD]9/3/17[/TD]
[TD]9/3/17[/TD]
[/TR]
[TR]
[TD]9/1/17[/TD]
[TD]Justin[/TD]
[TD]9/1/17[/TD]
[TD]9/1/17[/TD]
[/TR]
[TR]
[TD]9/2/17[/TD]
[TD]Justin[/TD]
[TD]9/2/17[/TD]
[TD]9/2/17[/TD]
[/TR]
[TR]
[TD]9/3/17[/TD]
[TD]Justin[/TD]
[TD]9/3/17[/TD]
[TD]9/3/17[/TD]
[/TR]
</tbody>[/TABLE]
I've gotten this far because of the following code that someone from here gave me to play with. I have been messing with it and attempting to make it work for what I need because originally it only referenced 2 columns. After I figure this problem out, I'm going to be looking into ways to make it all happen on the same tab. I can probably figure that out myself, but I'm open to input on all things considered.
Code:
Public Sub CrossJoinSelection()
Dim avntCartesian() As Variant
Dim wksOutput As Worksheet
Dim rngSelection As Range
Dim lngCounter As Long
Dim c1 As Range
Dim c2 As Range
Dim c3 As Range
Dim c4 As Range
Dim r1, r2, r3, myMultipleRange As Range
Set r1 = Sheets("ss1").Range("c4")
Set r2 = Sheets("ss1").Range("c3")
Set r3 = Sheets("ss1").Range("c1")
Set myMultipleRange = Union(r1, r2, r3)
myMultipleRange.Font.Bold = True
On Error GoTo ErrHandler
If Not TypeOf Selection Is Range Then
MsgBox "Selection must be a range.", vbExclamation
GoTo ExitProc
End If
Set rngSelection = Intersect(Selection, Selection.Parent.UsedRange)
If Not rngSelection Is Nothing Then
For Each myMultipleRange In rngSelection.Columns(1).Cells
If Not IsEmpty(myMultipleRange.Value) Then
For Each c2 In rngSelection.Columns(2).Cells
If Not IsEmpty(c2.Value) Then
lngCounter = lngCounter + 1
ReDim Preserve avntCartesian(1 To 4, 1 To lngCounter)
avntCartesian(1, lngCounter) = myMultipleRange.Value
avntCartesian(2, lngCounter) = c2.Value
avntCartesian(3, lngCounter) = myMultipleRange.Value
avntCartesian(4, lngCounter) = myMultipleRange.Value
End If
Next c2
End If
Next myMultipleRange
End If
If lngCounter > 0 Then
avntCartesian = TranposeArray(avntCartesian)
Set wksOutput = ThisWorkbook.Sheets.Add
wksOutput.Range("C13:F13").Value = Array("Column1", "Column2", "Column3", "Column4")
wksOutput.Range("C13:F13").Resize(lngCounter).Value = avntCartesian
Else
MsgBox "No values found in selection.", vbExclamation
End If
ExitProc:
Set rngSelection = Nothing
Set wksOutput = Nothing
Set c1 = Nothing
Set c2 = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitProc
End Sub
Private Function TranposeArray(avntSource() As Variant) As Variant()
Dim avntTarget() As Variant
Dim intLower1 As Integer
Dim intUpper1 As Integer
Dim lngLower2 As Long
Dim lngUpper2 As Long
Dim i As Integer
Dim j As Long
intLower1 = LBound(avntSource, 1)
intUpper1 = UBound(avntSource, 1)
lngLower2 = LBound(avntSource, 2)
lngUpper2 = UBound(avntSource, 2)
ReDim avntTarget(lngLower2 To lngUpper2, intLower1 To intUpper1)
For j = lngLower2 To lngUpper2
For i = intLower1 To intUpper1
avntTarget(j, i) = avntSource(i, j)
Next i
Next j
TranposeArray = avntTarget
End Function
I appreciate what you guys do here! Thanks any help.