Solved: Extracting required information

[justdriving]

Col A has employee id
Col B has Product number
Col C has Prod Name
Col D has Date
Col J has Selling Status

... all up to n-th row

I have been asked to find out those rows which have Selling Status as Sold. In Report,

• I have to only include Col A, B, C and D. I have to ignore other Columns.

• Report to be based on Employee id number. For example, in sheet2, A1 = first employee id and then from row2 to row n, values corresponding to Col B,C,D from Sheet1
  
  At end of data about first employee, A(n+2) = second employee, where n refers row number. and from A(n+3) in Col B, C, D respective info about second employee

Please help me how to do this in VBA, if possible with any data.

[mikerickson]

If you could attach a workbook with a small, but representative, sample of data and the desire result, we could get a better picture of what is required.

[Bob Phillips]

Use a pivot table.

[justdriving]

Hi ,

I am requesting VBA code for WorkingSheet in attachment. Please help.

[justdriving]

I have following function. How can I use this function in above context (not as a formula) so that formula doesn't appear on sheet.

[VBA]
Function OzgridLookup(Find_Val As Variant, Occurrence As Long, Table_Range As Range, _
Offset_Cols As Long, Optional Column_Lookin As Long, Optional Row_Offset As Long) As Variant

Dim lLoop As Long
Dim FoundCell As Range

If Column_Lookin = 0 Then 'No column # specified
With Table_Range
'Top left cell has Find_Val & Occurrence is 1
If Table_Range.Cells(1, 1) = Find_Val And Occurrence = 1 Then
OzgridLookup = .Cells(1, 1)(1, Offset_Cols + 1)
Exit Function 'All done
Else 'No column # specified so search all for _
nth Occurrence reading left to right
Set FoundCell = .Cells(1, 1) 'Set cell variable for Find start
For lLoop = 1 To Occurrence 'Loop as many times as Occurrences _
and each time Set "FoundCell" to start next Find from
Set FoundCell = _
Table_Range.Find(What:=Find_Val, After:=FoundCell, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlRows, SearchDirection:=xlNext)
Next lLoop
End If
End With
Else 'column # specified
With Table_Range.Columns(Column_Lookin) 'Work with column # specified
Set FoundCell = .Cells(1, 1) 'Set cell variable for Find start
For lLoop = 1 To Occurrence 'Loop as many times as Occurrences _
and each time Set "FoundCell" to start next Find from
Set FoundCell = _
Table_Range.Find(What:=Find_Val, After:=FoundCell, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlRows, SearchDirection:=xlNext)
Next lLoop
End With
End If

OzgridLookup = FoundCell.Offset(Row_Offset, Offset_Cols)

End Function



[/VBA]

Used in any cell like;

=OzgridLookup("Project 1",2,$A$1:$D$9,3,1,-1)

Source: http://www.ozgrid.com/VBA/ultimate-e...p-function.htm

[mikerickson]

This looks like it will do what you want.
[VBA]Sub test()
Dim dataRange As Range
Dim destinationRange As Range
Dim critrange As Range, destRange As Range
Dim UniqueEmployees As Range
Dim i As Long

With ThisWorkbook.Worksheets("WorkingSheet").Range("A:A")
Set dataRange = Range(.Cells(1, 5), .Cells(.Rows.Count, 1).End(xlUp))
End With
Set destinationRange = ThisWorkbook.Worksheets("Sheet2").Range("A1")
Set critrange = destinationRange.Offset(0, 2).Resize(2, 2)

Set destRange = critrange.Offset(0, critrange.Columns.Count + 2).Resize(1, dataRange.Columns.Count)

destinationRange.Parent.Cells.Clear
On Error Resume Next
dataRange.Parent.ShowAllData
On Error GoTo 0

dataRange.Columns(1).AdvancedFilter action:=xlFilterCopy, copytorange:=destinationRange, unique:=True

With destinationRange
.CurrentRegion.Sort Key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes, ordercustom:=1
End With

With critrange
.Cells(1, 1).Value = dataRange.Cells(1, 1).Value
.Cells(1, 2).Value = dataRange.Cells(1, 5).Value
.Cells(2, 2).Value = "Not Sold"
End With

For i = 2 To destinationRange.CurrentRegion.Rows.Count
critrange.Cells(2, 1).Value = destinationRange.Cells(i, 1).Value

dataRange.AdvancedFilter action:=xlFilterCopy, criteriarange:=critrange, copytorange:=destRange, unique:=False
With destRange
.Clear
.Insert shift:=xlDown
With .Offset(-1, -1)
.Cells(1, 1).Value = "Employee:"
.Cells(2, 1).Value = "Not Sold"
.Cells(1, 2) = critrange.Cells(2, 1).Value
End With
With .CurrentRegion
.Columns(.Columns.Count).Clear
Set destRange = destRange.Offset(.Rows.Count, 0)
End With

End With
Next i
Range(destinationRange, destRange.Offset(0, -2).Cells(1, 1)).EntireColumn.Delete
End Sub[/VBA]

[justdriving]

Hi mikerickson,
Mac Moderator

I think VBA Editor is disabled in aforesaid attachment. Please review

[justdriving]

I have some queries which I wish to ask. In following line, destrange was offset to 4 columns from critrange and then resized to 5 Columns. Kindly correct me if I am wrong. If true, kindly help me know some reason for doing so. It will help me understand program.

[VBA]
Set destRange = critrange.Offset(0, critrange.Columns.Count + 2).Resize(1, dataRange.Columns.Count)
[/VBA]

Also, I had reviewed this program and I wanted to ask, if you may accept my "Thank You", or Please specify what can I do for you?

[mikerickson]

Yes, that is what is happening to destRange.
Offset to get it out of the way (note that everything to the left of this destRange is deleted in the last line.)
Resized to the same number of columns as the dataRange, because AdvancedFilter is more stable with that than with a copyToRange of one cell.

You're quite welcome, this was a fun problem.