Results 1 to 4 of 4

Thread: Report using array?

  1. #1

    Report using array?


    I am generating report based on unique values I have attached excel file for ur reference. Input is in Sheet1. I need output as in sheet2.

    Thanks in advance


    Chandra Shekar

  2. #2
    VBAX Tutor
    Nov 2006
    North East Pennsylvania, USA

    With your raw data in Sheet1, the below macro will create a new worksheet Results per your request.

    Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

    Adding the Macro
    1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL + C
    2. Open your workbook
    3. Press the keys ALT + F11 to open the Visual Basic Editor
    4. Press the keys ALT + I to activate the Insert menu
    5. Press M to insert a Standard Module
    6. Paste the code by pressing the keys CTRL + V
    7. Press the keys ALT + Q to exit the Editor, and return to Excel
    8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

    Option Explicit
    Sub CreateReport()
    ' stanleydgrom, 10/19/2010, VE34594
    Dim w1 As Worksheet, wR As Worksheet
    Dim LR As Long
    Application.ScreenUpdating = False
    Set w1 = Worksheets("Sheet1")
    If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
    Set wR = Worksheets("Results")
    w1.Columns(3).Copy wR.Columns(1)
    w1.Columns(2).Copy wR.Columns(2)
    wR.Columns("A:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wR.Range("C1"), Unique:=True
    LR = wR.Cells.Find("*", , , , xlByRows, xlPrevious).Row
    wR.Range("A2:B" & LR).Copy
    wR.Range("C1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.ScreenUpdating = True
    End Sub

    Then run the CreateReport macro.

  3. #3
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Apr 2005
    ANother way


    Public Sub ProcessData()
    Const TEST_COLUMN As String = "A" '<<<< change to suit
    Dim Lastrow As Long
    Dim i As Long
    Dim cell As Range

    Application.ScreenUpdating = False

    With ActiveSheet

    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For i = 3 To Lastrow

    If .Cells(i - 1, "A").Value2 <> .Cells(i, "A").Value2 Then

    .Cells(i, "C").Copy .Cells(2, .Columns.Count).End(xlToLeft).Offset(0, 1)
    .Cells(i, "B").Copy .Cells(3, .Columns.Count).End(xlToLeft).Offset(0, 1)

    .Cells(i, "C").ClearContents
    End If
    Next i

    .Cells(3, "C").Insert Shift:=xlToRight
    .Cells(2, "B").Copy .Cells(3, "C")
    .Rows(4).Resize(Lastrow - 3).Delete
    End With

    Application.ScreenUpdating = True
    End Sub
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  4. #4
    Thank you all


    Chandra Shekar

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts