Interesting Question For Excel ChampionsSolved/Closed

Question

Hello,
Interesting Question Guys:

Suppose Sheet 1 Is "Data" Sheet

And There Are Too Many Rows...

Like
A3 Is S.No
B3 Is Supplier Name
C3 Is Date Of Purchase
D3 Is Item Name
E3 Is  Quantity
F3 Is Rate
G3 Is Value

If I Put My All Data In This Sheet........
And If I Run The Macro.....

The Formula Will Works As (Copy The First Supplier Name & Create A New Sheet As Supplier Named And Put That Row Data In That Sheet In Row3.
And Then Again Goto Data Sheet & Find The Second Supplier Name & Create A New Sheet As Supplier Named And Put That Row In That Sheet In Row3.
And Then Again Goto Data Sheet & Find The Third Supplier Name, If Third Supplier Name Was Same As First Supplier Name Then Goto 1st Supplier Named Sheet And Paste That Row Data In That Sheet In Row4 Because Row3 Is Already Pasted In First Case......


Hope You Will Find The Solution.

Regards,
Naeem

rizvisa1 · Accepted Answer

why would you go thru all this hassle 

1. Let macro make a unique supplier list , or do it manually (see Data- Filter - Advance filter) and paste all unique records on a new sheet

2 start looping thru. Create the new sheet, name it to that value, go to main sheet and apply filter for that name and copy the rows found on the newly created sheet.

rizvisa1 · Answer

Here you go Naeem Sub details() Sheets.Add ActiveSheet.Name = "tempsheet" Sheets("Sheet1").Select If ActiveSheet.AutoFilterMode Then Cells.Select Selection.AutoFilter End If Columns("B:B").Select Selection.Copy Sheets("tempsheet").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False Columns("A:A").Select Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True Columns("A:A").Delete Cells.Select Selection.Sort _ Key1:=Range("A2"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal lMaxSupp = Cells(65536, 1).End(xlUp).Row For suppno = 2 To lMaxSupp supName = Sheets("tempsheet").Range("A" & suppno) If supName <> "" Then Sheets.Add ActiveSheet.Name = supName Sheets("Sheet1").Select If ActiveSheet.AutoFilterMode Then Cells.Select Selection.AutoFilter End If Cells.Select If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter End If Selection.AutoFilter Field:=2, Criteria1:="=" & supName, Operator:=xlAnd, Criteria2:="<>" lastrow = Cells(65536, 2).End(xlUp).Row 'in case you want the headers to be pasted also Rows("1:" & lastrow).Copy ' in case you dont want the headers to be pasted ' Rows("2:" & lastrow).Copy 'normally you would paste on first row, but you wanted row 3 for some reason ' Sheets(supName).Range("A1").PasteSpecial Sheets(supName).Range("A3").PasteSpecial End If Next Sheets("tempsheet").delete Sheets("Sheet1").Select If ActiveSheet.AutoFilterMode Then Cells.Select Selection.AutoFilter End If End Sub

Game Start Now · Answer

And One More Thing, ( A2 ) Belongs To Header.. I Want A2 Row In All Sheets :)

rizvisa1 · Answer

ah that I leave for you as a challenge. 

Here is a hint

you answer would come here

'in case you want the headers to be pasted also
Rows("1:" & lastrow).Copy

' in case you dont want the headers to be pasted
' Rows("2:" & lastrow).Copy

'normally you would paste on first row, but you wanted row 3 for some reason
' Sheets(supName).Range("A1").PasteSpecial
Sheets(supName).Range("A3").PasteSpecial


other hint, use macro recorder to see how you can copy and paste a specific row

rizvisa1 · Answer

OK 
prob1) When You Run A Macro For This Data Only Karim's Sheet Get The Header & Rest Of The Sheets Donot Get The Header...

Make the following change to address it
Change this

Sheets.Add
ActiveSheet.Name = supName

Sheets("Sheet1").Select
if ActiveSheet.AutoFilterMode Then
Cells.Select
Selection.AutoFilter
End If


to 

Sheets.Add
ActiveSheet.Name = supName

Sheets("Sheet1").Select


Prob2) After You Run Macro 1st Time It Create The Sheets But When I Add A New Data In Main Sheet & Run The Macro It Gives Me An Error...

See these lines
Sheets.Add
ActiveSheet.Name = supName

Since the sheets were created the first time, the next time you try to create again it will error out. You cannot repeat sheet name

Prob3) After You Run Macro 1st Time It Create The Sheets But When I Edit Any Data In Main Sheet & Run The Macro It Donot Edit That Data In That Name's Sheet.

That is puzzling to me too. There has to be a reason, just dont know what. However here is the fix for it

Change this
Application.CutCopyMode = False

To

Application.CutCopyMode = False

If (Cells(1, 1) = "") Then
    lastrow = Cells(1, 1).End(xlDown).Row
    If lastrow <> 65536 Then
        Range("A1:A" & lastrow - 1).Select
         Selection.Delete Shift:=xlUp
    End If
End If

How ever you still would run into one more issue and right now I dont have an answer for that. For the time being my fix is 


Change this

ActiveSheet.Name = "tempsheet"

Sheets("Sheet1").Select

If ActiveSheet.AutoFilterMode Then
Cells.Select
Selection.AutoFilter
End If


to

ActiveSheet.Name = "tempsheet"

Sheets("Sheet1").Select

If ActiveSheet.AutoFilterMode Then
Cells.Select
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End If


and this 
Sheets("tempsheet").Delete

Sheets("Sheet1").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
Selection.AutoFilter
End If


to 

Sheets("tempsheet").Delete

Sheets("Sheet1").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
ActiveSheet.ShowAllData
End If

rizvisa1 · Answer

Ok if you do all then you should end up with this Sub details() Sheets.Add ActiveSheet.Name = "tempsheet" Sheets("Sheet1").Select If ActiveSheet.AutoFilterMode Then Cells.Select On Error Resume Next ActiveSheet.ShowAllData On Error GoTo 0 End If Columns("B:B").Select Selection.Copy Sheets("tempsheet").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False If (Cells(1, 1) = "") Then lastrow = Cells(1, 1).End(xlDown).Row If lastrow <> 65536 Then Range("A1:A" & lastrow - 1).Select Selection.Delete Shift:=xlUp End If End If Columns("A:A").Select Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True Columns("A:A").Delete Cells.Select Selection.Sort _ Key1:=Range("A2"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal lMaxSupp = Cells(65536, 1).End(xlUp).Row For suppno = 2 To lMaxSupp supName = Sheets("tempsheet").Range("A" & suppno) If supName <> "" Then Sheets.Add ActiveSheet.Name = supName Sheets("Sheet1").Select Cells.Select If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter End If Selection.AutoFilter Field:=2, Criteria1:="=" & supName, Operator:=xlAnd, Criteria2:="<>" lastrow = Cells(65536, 2).End(xlUp).Row 'in case you want the headers to be pasted also Rows("1:" & lastrow).Copy ' in case you dont want the headers to be pasted ' Rows("2:" & lastrow).Copy Sheets(supName).Range("A1").PasteSpecial End If Next Sheets("tempsheet").Delete Sheets("Sheet1").Select If ActiveSheet.AutoFilterMode Then Cells.Select ActiveSheet.ShowAllData End If End Sub I have just realized that filter seems to act differently if you save the file before running it. One of excel weird things i guess

rizvisa1 · Answer

Yeah and I think i did say so too. May be you missed it


Prob2) After You Run Macro 1st Time It Create The Sheets But When I Add A New Data In Main Sheet & Run The Macro It Gives Me An Error...

See these lines
Sheets.Add
ActiveSheet.Name = supName

Since the sheets were created the first time, the next time you try to create again it will error out. You cannot repeat sheet name 

So yes, either you delete the sheet or you bypass the sheet creation if already exists. It all depends on what is the requiement

rizvisa1 · Answer

for each x in sheets

if (x.name = ???) then

 x.delete

else if (some other condition)
x.delete

else

end if

next


You can see the code of delete by using macro recording. macro recording is the best help around

rizvisa1 · Answer

ok what you want. be clear in when a sheet is going to be delete. what you mean "two words", Since you are not removing any data from the main sheet, it seem that you would be ok with deleting sheets.

if that is the case 

where it says 

Sheets.Add
ActiveSheet.Name = "tempsheet" 

make this change

' delete all sheets but the sheet named "Sheet1"
for each x in sheets

'here sheet1 refers to the main sheet name. change it to what ever is the name of main sheet
if (x.name <> "Sheet1") then
x.delete

end if

next

Sheets.Add
ActiveSheet.Name = "tempsheet"

rizvisa1 · Answer

Good Job!! 

yeah Rahbar cooler app ka howa :P

Game Start Now · Answer

hehehe

Thanks Alot Dude

Hey Dude Where You From ?

rizvisa1 · Answer

from karachi, pakistan

in detroit, usa

Game Start Now · Answer

Acha Karachi Say Ho But Now In USA.....

Good

Game Start Now · Answer

Programmer Ho Aap ?

Game Start Now · Answer

Dude Macro Recording Kaisay Help Karta Hai

Mere Pass Wo Software Nehi Hai

Please E-mail Me

naeemahmed123@hotmail.com

rizvisa1 · Answer

it is in excel it self

Go to tools then macro and there you will see option of record macro

Game Start Now · Answer

how can i paste that data with cell width ?

Selection.PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False 







Sheets(supName).Range("A1").PasteSpecial Paste:xlColumnWidths ?


Is This Works ?

rizvisa1 · Answer

try this


Sheets(supName).Range("A1").PasteSpecial Paste:=xlPasteAll

rohan_wagela · Answer

dear all, 
I will tell you the question in more detail. 
In sheet1 I am entering the data for the whole year, in column f I am entering names.(10 diff. names). 
I have made separate sheet for each person. when a name comes in column f in any row it should get copied to the sheet created for that person(sheet2). If the same name again comes in sheet1 column f , then it should get copied in the next row(sheet2). and when i am updating the row in sheet1 it should get updated in the sheet2 if it had been copied to sheet2 earlier.

rizvisa1 · Answer

You can still use this macro. This macro was based on column B and you want column F, a minor change that you should be able to do. Since you not only wants the rows copied over to individual sheets, but once a row has been copied you also wants any update to be reflected too. Well in a way this macro does that. When ever you run the macro, it delete all previous reports and then would start new so any change would would captured.

Interesting Question For Excel Champions

20 responses

Similar discussions

Subscribe To Our Newsletter!