VBA-issues refrencing multiple range selections

D

ddoctor

New Member
Joined
Aug 30, 2017
Messages
27
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.

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.
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
How do you get from the initial data in the table you posted to the result you want?

Is there any logic, patterns, rules?
 
Upvote 0
Norie said:
How do you get from the initial data in the table you posted to the result you want?

Is there any logic, patterns, rules?
Click to expand...

I suppose that would be better answered by the person that provided it to me, but after working with the code it appears that this section is what generates the pattern needed.
Code: 
 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

Originally it looked at only the first to columns, so it appeared to make sure each individual date would only replicate itself according the to amount of names entered into the 2nd column.

Originally when I began playing with it to include 4 columns, I would end up with an extremely long list because it would list every possible arrangement.

The code I provided above was an attempt to group columns 1,3,and 4 together. As of right now it assigns the dates correctly, but doesn't include the data from columns 3,4.

I hope that answers your question, I'm pretty new to all of this so I'm pretty sure there was a better way to describe what I'm saying lol
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
using vba excel to unpivot with multiple categories (1 w/ 4 columns & 1 w/ 5 columns) of data
2
Replies
13
Views
1K
Fluff
Fluff
randaubienghoc
  • Question Question
Send bulk email from Excel issues: 1-Attach multiple files with file paths, 2-Copy visible ranges and 3-Add default email signature keeping formats
Replies
0
Views
794
randaubienghoc
randaubienghoc

Forum statistics

Threads
1,224,823
Messages
6,181,173
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top