CountTriple ColumnsToTable Format

**Cherub** · 07-03-2009, 10:34 AM

I am using this macro to get Column A:C on Sheet1 to look like Column A:AA on Sheet2 of the attachment. I seem to be having trouble with the line of the code “LRA = Range("A:B" & Rows.Count).End(xlUp).Row”. JBeaucaire I hope I didn’t butcher your original too much. I am trying to do this with a macro instead of a pivot table. Any direction is much appreciated.

Sub CountTripleColumnsToTableFormat()
'Reassemble a three column list of repeating values into a table and count the duplicates
Dim LC As Long, LRA As Long, LRC As Long
Application.ScreenUpdating = False
LRA = Range("A:B" & Rows.Count).End(xlUp).Row

Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"), Unique:=True
Range("D2:D11").Copy
Range("D1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Range("D2:D11").ClearContents
Application.CutCopyMode = False

Cells.Columns.AutoFit
Columns("D:D").Insert Shift:=xlToRight
Range("A1:B" & LRA).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D2"), Unique:=True
If Range("D2").Value = Range("D3").Value Then Range("D3").Delete (xlShiftUp)
Range("Extract").Name.Delete

LRC = Range("D" & Rows.Count).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column

With Range("E2", Cells(LRC, LC))
.FormulaR1C1 = "=SUMPRODUCT(--(R1C1:R" & LRA & "C1=RC3),--(R1C2:R" & LRA & "D2=R1C))"
.Value = .Value
.NumberFormat = "General"
.HorizontalAlignment = xlCenter
End With

Columns("A:C").Delete Shift:=xlToLeft
Range("C2").Select

Application.ScreenUpdating = True
End Sub

**StephenR** · 07-03-2009, 10:40 AM

If you want the last used row in column A it should be

LRA = Range("A" & Rows.Count).End(xlUp).Row

**Cherub** · 07-04-2009, 12:33 AM

Hi Stephen. Thank you for the input. I changed that line of the code, but I am still not able to get this macro working. Any additional feedback is much appreciated.

**StephenR** · 07-04-2009, 07:26 AM

Does a different line error now? If so, which one and what is the error? Or does the macro run but not do what you want?

**Cherub** · 07-04-2009, 02:14 PM

Thank you for your question. The macro runs. I get a debug message. Once I close the debug message and click on the worksheet it seems like there is numbers all over the place. It is having problems.

**Cherub** · 07-06-2009, 12:37 PM

I am still having trouble with the original post. Any help, I greatly appreciate.

**DonkeyOte** · 07-06-2009, 12:50 PM

I've only looked at this briefly but based on your intended output sheet and source data perhaps the below might work for you ?

Sub CountTripleColumnsToTableFormat()
'Reassemble a three column list of repeating values into a table and count the duplicates
Dim LC As Long, LRA As Long, LRC As Long
Application.ScreenUpdating = False
LRA = Cells(Rows.Count, "A").End(xlUp).Row
Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"), Unique:=True
With Range(Cells(2, "D"), Cells(Rows.Count, "D").End(xlUp))
    .Copy
    Range("D1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    .ClearContents
    Application.CutCopyMode = False
End With
Cells.Columns.AutoFit
Columns("D:E").Insert Shift:=xlToRight
Range("A1:B" & LRA).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D2"), Unique:=True
If Range("D2").Value = Range("D3").Value Then Range("D3:E3").Delete (xlShiftUp)
Range("Extract").Name.Delete
LRC = Range("D" & Rows.Count).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
With Range("F2", Cells(LRC, LC))
    .FormulaR1C1 = "=SUMPRODUCT(--(R1C1:R" & LRA & "C1=RC4),--(R1C2:R" & LRA & "C2=RC5),--(R1C3:R" & LRA & "C3=R1C))"
    .Value = .Value
    .NumberFormat = "General;;"
    .HorizontalAlignment = xlCenter
End With
Columns("A:C").Delete Shift:=xlToLeft
Range("C2").Select
Application.ScreenUpdating = True
End Sub