Interesting Question For Excel Champions

Solved/Closed
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
- Feb 3, 2010 at 01:03 PM
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
- 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

20 replies

rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 3, 2010 at 01:11 PM
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.
5
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 4, 2010 at 02:04 AM
And One More Thing, ( A2 ) Belongs To Header.. I Want A2 Row In All Sheets :)
1
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 4, 2010 at 06:12 AM
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
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 4, 2010 at 12:03 PM
I Can't Dude......

Please Check E-mail.....
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 4, 2010 at 02:34 PM
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
0

Didn't find the answer you are looking for?

Ask a question
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 4, 2010 at 02:44 PM
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
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 4, 2010 at 10:11 PM
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 ?
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 5, 2010 at 04:42 AM
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
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 5, 2010 at 05:56 AM
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.
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 5, 2010 at 06:03 AM
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
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 5, 2010 at 06:10 AM
then why dont you change the upper coding & add this coding for edit........ :(
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 5, 2010 at 06:22 AM
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"
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 5, 2010 at 06:34 AM
Good Job!!

yeah Rahbar cooler app ka howa :P
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 5, 2010 at 06:38 AM
hehehe

Thanks Alot Dude

Hey Dude Where You From ?
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 5, 2010 at 06:41 AM
from karachi, pakistan

in detroit, usa
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 5, 2010 at 06:49 AM
Acha Karachi Say Ho But Now In USA.....

Good
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 5, 2010 at 06:50 AM
Programmer Ho Aap ?
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 5, 2010 at 07:02 AM
Dude Macro Recording Kaisay Help Karta Hai

Mere Pass Wo Software Nehi Hai

Please E-mail Me

naeemahmed123@hotmail.com
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 5, 2010 at 07:08 AM
it is in excel it self

Go to tools then macro and there you will see option of record macro
0
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 5, 2010 at 07:24 AM
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 ?
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 5, 2010 at 08:06 AM
try this


Sheets(supName).Range("A1").PasteSpecial Paste:=xlPasteAll
0
rohan_wagela
Posts
3
Registration date
Thursday April 8, 2010
Status
Member
Last seen
April 9, 2010

Apr 9, 2010 at 06:25 AM
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.
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Apr 9, 2010 at 08:54 AM
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.
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
770
Feb 3, 2010 at 04:48 PM
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
-1
Game Start Now
Posts
138
Registration date
Thursday January 21, 2010
Status
Member
Last seen
May 8, 2019
7
Feb 4, 2010 at 01:34 AM
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..........
0