Adv Data Seperation

[ads_3131]

Morning !

Possibly a simple one, or not....

Have a workbook, contains two sheets. Sheet1 is Data (will be variable as it is an import) Sheet2 needs to breakup the raw data from Sheet1

In Sheet2 i am wanting to put the Supplier problems (including all fields on that Row or range) into one table. And then our problems into the other table...

These 2 categories (ours & suppliers) are in different columns.... maybe that will make the task simplier?


---------------
Maybe the below is the right path? or most likely not?
----------------------------
i used the formula below before (works on the same sheet by adding a name to the range) but this doesnt work on an different sheet.

=IF(ROW()-ROW( SupNoBlanks)+1>ROWS( SupBlanksRange)-COUNTBLANK( SupBlanksRange),"",INDIRECT( ADDRESS(SMALL((IF(SupBlanksRange<>"",ROW( SupBlanksRange),ROW()+ROWS( SupBlanksRange))),ROW()-ROW( SupNoBlanks)+1),COLUMN( SupBlanksRange),4)))

Also to make it more complex.... it only pulls in data from one column while i want rows with it.

Picking my brains at it and hopefully a VBA wizzard will put me on the right path

Attached is an example sheet... with raw data on sheet1. and sheet2 containing 2 tables which the end result should be a seperation by our problems or the supplier problems

thankyou in advance

[Bob Phillips]

Can you re-post the workbook with a few in both tables on Separation completed, so we can see what you want.

[ads_3131]

Okay....

Find attached... an basic outcome

The Formattings slighty different from the original example attachment

This Attachement is how exactly it should look.

Find attached.....

Thanks

[IanFScott]

Assuming 'SU' = Supplier problem then this code does it:
[vba]Option Explicit
Sub Separate()
Dim WSNCR As Worksheet
Dim WSSep As Worksheet
Dim CurOwnRow As Integer
Dim CurSupRow As Integer
Dim CurCol As Integer
Dim CurNCRRow As Integer
Set WSNCR = ThisWorkbook.Sheets("NCR")
Set WSSep = ThisWorkbook.Sheets("Seperation")
WSSep.Range("B6:Z500").ClearContents
CurOwnRow = 6
CurSupRow = 6
With WSNCR
CurNCRRow = 4
Do Until IsEmpty(.Cells(CurNCRRow, 2))
If .Cells(CurNCRRow, 8).Text = "SU" Then
For CurCol = 2 To 13
WSSep.Cells(CurSupRow, CurCol + 13) = .Cells(CurNCRRow, CurCol)
Next
CurSupRow = CurSupRow + 1
Else
For CurCol = 2 To 13
WSSep.Cells(CurOwnRow, CurCol) = .Cells(CurNCRRow, CurCol)
Next
CurOwnRow = CurOwnRow + 1
End If
CurNCRRow = CurNCRRow + 1
Loop
End With
End Sub
[/vba]

[ads_3131]

Thanks IanFScott

Very very close.....

but its not by "SU"

Its actually ... anything thats in the "supplier" column (sheet1) is a supplier problem.... anything thats in the "own problem" column (sheet1) is our problems....

soo close tho...

thanks

[Bob Phillips]

[VBA]Public Sub ProcessData()
Dim target As Worksheet
Dim rng As Range
Dim rng2 As Range

Set target = Worksheets("Seperation")

With target

Worksheets("NCR").UsedRange.Copy .Range("A1")

Set rng = .Range("A2").Resize(Application.Count(.Columns(1)), 12)
rng.AutoFilter field:=5, Criteria1:="="
Set rng = rng.Offset(1)
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.Delete shift:=xlUp
.Range("E2").AutoFilter

Worksheets("NCR").UsedRange.Copy .Range("N1")

Set rng = .Range("N2").Resize(Application.Count(.Columns(1)), 12)
rng.AutoFilter field:=6, Criteria1:="="
Set rng = rng.Offset(1)
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.Delete shift:=xlUp
.Range("S2").AutoFilter

.Rows(1).Delete
.Rows("1:4").Insert
With .Range("A3")

.Value = "OUR PROBLEMS"
.Font.Size = 18
End With
With .Range("N3")

.Value = "SUPPLIER PROBLEMS"
.Font.Size = 18
End With

.Columns("A").Insert
.Columns("A").ColumnWidth = 1
.Columns("N").ColumnWidth = 1

.Activate

ActiveWindow.Zoom = 85
End With
End Sub
[/VBA]

[ads_3131]

Thanks Xld ... got that working fine on Excel 2010...

However Excel 2000 has an issue with "
Set rng = .Range("A2").Resize(Application.Count(.Columns(1)), 12)"

??? any idea's?