Split data on multiple range

P

Prabhu

New member
Joined
Nov 5, 2013
Messages
8
Reaction score
0
Points
0
Hi Friends,

I need to copy the transactions from the sheet “data” for the “products” mentioned in the sheet “summary” and for the date range given in the sheet “summary” in to the new sheet with the name of Sequence number given in the summary sheet(Ex.Sequence01).

Also relevant data of fields like Price, % and Unit details to be copied to “Sequence01” sheet.

I have done manually for your reference. Kindly help to get the Macro to get Sequence sheet with the information from the sheet Summary and Data.

Thank you so much,

Regards,
Prabhu
 

Attachments

  • SPLIT DATAII.xlsx
    23.5 KB · Views: 12
Try this macro on your sample workbook. It adds a sheet named according to the cell B2 in the Summary sheet. This sheet name already exists, so before you run this macro you should rename your sample results sheet to something else, otherwise an error will occur.
The results are not the same as your sample results because your results sheet contains rows which could not have come from the Data sheet (for example, you do not have a Product ABC789 on 23-Jul-13 on your Data sheet, but you do have it on your Sequence 01 sheet).
The macro is not especially robust since I have made a few assumptions, so may not work well with different data, especially if there is more than 1 sequence number in the Summary sheet.
Code: 
Sub blah()
Set wsAFC = Sheets.Add
Set wsResults = Sheets.Add(after:=Sheets(Sheets.Count))
wsResults.Name = Sheets("Summary").Range("B2").Value
lr = Sheets("Summary").Cells(Rows.Count, "E").End(xlUp).Row
Sheets("Summary").Range("E1:E" & lr).Copy wsAFC.Range("A1")
Sheets("Data").Range("I1").Copy wsAFC.Range("B1:C1")
Sheets("Summary").Range("C2").Copy
wsAFC.Range("B2:B" & lr).FormulaR1C1 = ">=" & Sheets("Summary").Range("C2").Value
Sheets("Summary").Range("D2").Copy
wsAFC.Range("C2:C" & lr).FormulaR1C1 = "<=" & Sheets("Summary").Range("D2").Value
Sheets("Data").Range("A1:T101").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsAFC.Range("A1:C7"), CopyToRange:=wsResults.Range("A1"), Unique:=False
Application.DisplayAlerts = False
wsAFC.Delete
Application.DisplayAlerts = True
With wsResults
  lr = .Cells(.Rows.Count, "K").End(xlUp).Row
  .Range("U2:U" & lr).FormulaR1C1 = "=VLOOKUP(RC[-10],Summary!C[-16]:C[-15],2,0)"
  .Range("V2:V" & lr).FormulaR1C1 = "=VLOOKUP(RC[-11],Summary!C[-17]:C[-15],3,0)"
  .Range("W2:W" & lr).FormulaR1C1 = "=VLOOKUP(RC[-12],Summary!C[-18]:C[-15],4,0)"
  Sheets("Summary").Range("F1:H1").Copy .Range("U1")
End With
End Sub

In the attached workbook the above macro is executed by pressing Button 1 on the Summary sheet.
 

Attachments

  • Excelguru2596.xlsm
    32.4 KB · Views: 11
Hi,

Thanks.

But when i run the macro sequence1 sheet donse not having any date then header.

Kindly do the needful.
 
I developed this in Excel 2003 in Excel 2010 compatibility mode.. clearly it's not as compatible as they thought, so here's the file again, developed in Exel 2010, with small adjustemnts to the code:
Code: 
Sub blah()
Set wsAFC = Sheets.Add
Set wsResults = Sheets.Add(after:=Sheets(Sheets.Count))
wsResults.Name = Sheets("Summary").Range("B2").Value
lr = Sheets("Summary").Cells(Rows.Count, "E").End(xlUp).Row
Sheets("Summary").Range("E1:E" & lr).Copy wsAFC.Range("A1")
Sheets("Data").Range("I1").Copy wsAFC.Range("B1:C1")
wsAFC.Range("B2:B" & lr).FormulaR1C1 = ">=" & CLng(Sheets("Summary").Range("C2").Value)
wsAFC.Range("C2:C" & lr).FormulaR1C1 = "<=" & CLng(Sheets("Summary").Range("D2").Value)
Sheets("Data").Range("A1:T101").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsAFC.Range("A1:C7"), CopyToRange:=wsResults.Range("A1"), Unique:=False
Application.DisplayAlerts = False
wsAFC.Delete
Application.DisplayAlerts = True
With wsResults
  lr = .Cells(.Rows.Count, "K").End(xlUp).Row
  .Range("U2:U" & lr).FormulaR1C1 = "=VLOOKUP(RC[-10],Summary!C[-16]:C[-15],2,0)"
  .Range("V2:V" & lr).FormulaR1C1 = "=VLOOKUP(RC[-11],Summary!C[-17]:C[-15],3,0)"
  .Range("W2:W" & lr).FormulaR1C1 = "=VLOOKUP(RC[-12],Summary!C[-18]:C[-15],4,0)"
  Sheets("Summary").Range("F1:H1").Copy .Range("U1")
End With
End Sub
 

Attachments

  • Excelguru2596.xlsm
    34.4 KB · Views: 8
Hi,

Thanks once again!

it is coping the part number and it detail fine.

but it is not considering the date range given in the summary sheet and it is working for the entire transactions of the data sheet.

Kindly check and do the needful.
 
Ok, actually i had changed the date hence it has not working properly.

now i changed code to CriteriaRange:=wsAFC.Range("A1:C7"& lr) then it is working fine.

Thank you somuch for your support.

Regards,

Prabhu
 
You must log in or register to reply here.
Back
Top