Interesting Question For Excel Champions [Solved/Closed]

Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
- - Latest reply: rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
- Apr 9, 2010 at 08:54 AM
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
See more 

20 replies

Best answer
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
5
Thank you
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.

Say "Thank you" 5

A few words of thanks would be greatly appreciated. Add comment

CCM 6766 users have said thank you to us this month

Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6
1
Thank you
And One More Thing, ( A2 ) Belongs To Header.. I Want A2 Row In All Sheets :)
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
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
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6 -
I Can't Dude......

Please Check E-mail.....
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
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
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
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
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6 -
Dude The Main 1 Problem Is Still Coming....

1) After Running The Macro First Time When I Edit Or Add The Data In Main Sheet & Run The Macro It Gives Me Debug Error.

(Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic).


I Think This Problem Can Solve Like (If I Edit Any Data Or Enter Any New Data In Main Sheet & Run The Macro Second Time Then It Delete All Sheets Except Main Sheet & Create New Sheets As SuppName & Paste There, So That Edit Can Works..........

What Do You Think Dude ?
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
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
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6 -
tell me what is the formula in macro

if all sheets name length is less than 2 words than
donot delete that sheet.

else delete all sheets.
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
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
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6 -
then why dont you change the upper coding & add this coding for edit........ :(
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
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"
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
Good Job!!

yeah Rahbar cooler app ka howa :P
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6
0
Thank you
hehehe

Thanks Alot Dude

Hey Dude Where You From ?
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
from karachi, pakistan

in detroit, usa
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6
0
Thank you
Acha Karachi Say Ho But Now In USA.....

Good
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6
0
Thank you
Programmer Ho Aap ?
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6
0
Thank you
Dude Macro Recording Kaisay Help Karta Hai

Mere Pass Wo Software Nehi Hai

Please E-mail Me

naeemahmed123@hotmail.com
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
it is in excel it self

Go to tools then macro and there you will see option of record macro
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6
0
Thank you
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 ?
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
try this


Sheets(supName).Range("A1").PasteSpecial Paste:=xlPasteAll
Posts
3
Registration date
Thursday April 8, 2010
Status
Member
Last seen
April 9, 2010
0
Thank you
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.
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
0
Thank you
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.
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
750
-1
Thank you
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
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
6 -
When I Run Macro It Works....

But After Running A Macro I Edit Any Data In Main Sheet & Run The Macro Again It Give Me An Error..

I Want That If I Edit Any Data In Main Sheet & Run The Macro Then Macro Delete All Sheets Except Main Sheet & Create New Sheets So That Edit Can Works..........