• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Conversion of report into desired and simple report

Hii

I have system generated report which i want to covert in the manner so that reasons of return and batch no both appear in the adjacent cells of a invoice. Presently they are appearing at top of invoice and appearing at variable positions. To make it more understandable I have attached the report extract which is in Sheet 1 and the desired output in sheet 2.Please help
 

Attachments

Please try the code on backup copy. I have tested it on the sample and works fine.

I have put comments in the code so it should be easier for you to check and change if something changes.
Code:
Option Explicit
Public Sub Format_Data()
Dim wsProcess As Worksheet
Dim rngLst As Range
Dim lngRow As Long, i As Long
 
'\\First delete sheet if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Processed_Output").Delete
Application.DisplayAlerts = True
On Error GoTo 0
 
'\\Copy original data sheet
Sheets("Sheet1").Copy After:=Sheets(Sheets.Count) 'Change Name Sheet1 if it is different for you
Set wsProcess = ActiveSheet
 
'\\Process Data
With wsProcess
    .Name = "Processed_Output"
    '\\Find out last row
    Set rngLst = .Cells.Find("*", .Range("A1"), xlValues, xlPart, xlByRows, xlPrevious, False)
    .Range(.Cells(1, "A"), rngLst).UnMerge
    lngRow = rngLst.Row
   
    '\\Copy data to new columns for rearrangement
    '\\Check two specific columns B & C for words Batch No : & Return Reason :
    For i = rngLst.Row To 1 Step -1
        If .Cells(i, "C").Value = "Return Reason :" Then _
            .Cells(i, "H").Copy .Cells(i, "AC")
        If .Cells(i, "B").Value = "Batch No :" Then _
            .Cells(i, "I").Copy .Cells(i, "AD")
    Next i
   
    '\\Now fill up blank rows with this copied data
    With .Range("AC2:AD" & lngRow)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Columns(1).Value = .Columns(1).Value
    End With
   
    '\\Direct value method drops leading zeroes so loop through it
    For i = lngRow To 2 Step -1
        .Cells(i, "AD").Value = "'" & .Cells(i, "AD").Value
    Next i
   
    .Cells(2, "W").Cut .Cells(2, "V") 'Invoice Amount column label moved to right place
    .Cells(2, "AC").Resize(1, 2).Value = Array("Return Reason", "Batch No") 'Assign header
   
    '\\Delete unwanted columns
    For i = .Cells(2, "AD").Column To 1 Step -1
        If .Cells(2, i).Value <> "Invoice Amount" And _
        .Cells(2, i).Value <> "Invoice" And _
        .Cells(2, i).Value <> "Account No" And _
        .Cells(2, i).Value <> "Return Reason" And _
        .Cells(2, i).Value <> "Batch No" Then _
        .Columns(i).Delete
    Next i
   
    '\\Delete unwanted rows
    With .Range(.Cells(2, "A"), .Cells(lngRow, "E"))
        .AutoFilter Field:=3, Criteria1:="="
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
   
    '\\Show data and adjust column widths
    .ShowAllData
    .Columns.AutoFit
    If .AutoFilterMode Then .AutoFilterMode = False
   
End With
 
End Sub
 
Hii Shri...the code is working fine..thks a ton...actually i have tried the following code also (But i m trying to figure out some formula for it). My code is as under

Sub Test()
Dim ShNew As Worksheet
Dim r As Long
Dim LastRow As Long
Dim i As Long
Dim Batch As Long
Dim Reason As String
Set ShNew = Worksheets.Add
ShNew.Range("A1:E1").Value = Array("Account", "Invoice", "Invoice Amount", "Return Reason", "Batch No")
r = 1
With Worksheets("Sheet1")
LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If .Range("B" & i).Value = "Batch No :" Then
Batch = .Range("I" & i).Value
ElseIf .Range("B" & i).Value <> "" Then
r = r + 1
ShNew.Cells(r, 1).Value = .Range("K" & i).Value
ShNew.Cells(r, 2).Value = .Range("O" & i).Value
ShNew.Cells(r, 3).Value = .Range("V" & i).Value
ShNew.Cells(r, 4).Value = Reason
ShNew.Cells(r, 5).Value = Batch
ElseIf .Range("C" & i).Value = "Return Reason :" Then
Reason = .Range("H" & i).Value
End If
Next i
End With
ShNew.Cells.EntireColumn.AutoFit
End Sub
 
Amit, very nice approach and it is much better than what I have done.

I think the report is designed for some "hard copy" printing [which should explain its formatting and merged cells :eek: ]. Check if it is possible for the software to generate standard report then you really don't need to do all this stuff in Excel.

You didn't mention you wanted a formula solution. Here's one way which should work for you.
1. Create a Sheet Named "Final Summary"

2. In cell B1 array enter [CTRL+SHIFT+ENTER] following formula:
Code:
=INDEX(Sheet1!$O$1:$O$50,SMALL(IF(Sheet1!$O$1:$O$50<>"",ROW(Sheet1!$O$1:$O$50)),ROWS($A$1:A1)))
and copy it down until you get error.

3. In cell A2 enter following normal formula :
Code:
=INDEX(Sheet1!$O$1:$O$50,SMALL(IF(Sheet1!$O$1:$O$50<>"",ROW(Sheet1!$O$1:$O$50)),ROWS($A$1:A1)))
copy down to the last row in column B.

4. In cell C2 enter following normal formula
Code:
=VLOOKUP(B8,Sheet1!$O$1:$V$50,8,0)
copy down to the last row in column B.

5. In cell D2 enter following normal formula
Code:
=LOOKUP("z",Sheet1!$H$1:INDEX(Sheet1!$H$1:$H$50,MATCH('Final Summary'!B2,Sheet1!$O$1:$O$50,0)))
copy down to the last row in column B.

6. In cell E2 enter following normal formula
Code:
=LOOKUP("z",Sheet1!$I$1:INDEX(Sheet1!$I$1:$I$50,MATCH('Final Summary'!B2,Sheet1!$O$1:$O$50,0)))
copy down to the last row in column B.

7. Cell B1 gets header automatically from formula. Assign headings in A1, C1, D1 & E1

It should look like what you need. If you find instructions difficult to follow then let me know. I will upload a sample file. But I'd be happy if you can try it on your own and improvise it.
 
Thanks for the feedback. Good to know that you've 3 solutions that work :) .

Keep visiting the challenges section. Formulas posted there are mostly belong to array category. It should help you.
 
I have bit a modified file in which the desired solution is in sheet 2 but the red one is still not solved...tried a lot...remaing are solved...i have let the formulas used as guided by you and previous knowledge..file attached to resolve the red one in sheet 2...input is in sheet1
 

Attachments

The layouts are print friendly and unwieldy for Excel usage.

Try following ARRAY formula in F2 and copy down:
Code:
=INDEX(Sheet1!$E$1:$E$500,MAX(IF(Sheet1!$B$1:INDEX(Sheet1!$B$1:$B$500,MATCH(A2,Sheet1!$E$1:$E$500,0))="Location :",ROW(Sheet1!$B$1:INDEX(Sheet1!$B$1:$B$500,MATCH(A2,Sheet1!$E$1:$E$500,0))))))
 
It's working great.........really u r amazing...no words to explain the knowledge levels u have....Can u suggest some books and sites to study and practice
 
Back
Top