Macro Application
Closed
Rahul
-
Apr 12, 2010 at 10:28 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Apr 15, 2010 at 06:43 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Apr 15, 2010 at 06:43 AM
Related:
- Macro Application
- Wd drive unlock application - Guide
- Hp smart application pc - Download - Other
- Windows10upgrade9252.exe is not a valid win32 application - Guide
- Spell number in excel without macro - Guide
- Free java application download - Download - Other
5 responses
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Apr 13, 2010 at 05:51 AM
Apr 13, 2010 at 05:51 AM
It depends upon your configuration of database.
suppose the sample data is like this
emp h2 h3 h4 h5 h6 h7 h8 manager
a 733 910 208 226 521 655 137 q
s 300 92 743 780 987 611 107 w
d 103 632 724 224 528 598 337 q
f 790 553 645 522 889 15 865 w
g 796 457 779 482 298 891 857 e
h 82 323 216 506 885 838 826 r
j 440 281 327 490 339 521 345 t
k 978 689 38 214 224 463 643 r
one employee can have one manager but one manager can have more than one employee under him/her.
1. find the unique managers name using advanced filter.in this case it will be q,w,e,r,t. park these unique managers name in a range e.g 5 rows below the main data. e.g. A15 down. A15 will have heading "manager"
rest managers' names
2. loop through each manager's name and autofilter main data with respect to that manager, copy visible data to the respective workbook sheet 1 range("A1").everytime copying is over you remove the autofilter and again autofilter for next manager.
can you RECORD a macro on this and edit it .
suppose the sample data is like this
emp h2 h3 h4 h5 h6 h7 h8 manager
a 733 910 208 226 521 655 137 q
s 300 92 743 780 987 611 107 w
d 103 632 724 224 528 598 337 q
f 790 553 645 522 889 15 865 w
g 796 457 779 482 298 891 857 e
h 82 323 216 506 885 838 826 r
j 440 281 327 490 339 521 345 t
k 978 689 38 214 224 463 643 r
one employee can have one manager but one manager can have more than one employee under him/her.
1. find the unique managers name using advanced filter.in this case it will be q,w,e,r,t. park these unique managers name in a range e.g 5 rows below the main data. e.g. A15 down. A15 will have heading "manager"
rest managers' names
2. loop through each manager's name and autofilter main data with respect to that manager, copy visible data to the respective workbook sheet 1 range("A1").everytime copying is over you remove the autofilter and again autofilter for next manager.
can you RECORD a macro on this and edit it .
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Apr 13, 2010 at 10:30 PM
Apr 13, 2010 at 10:30 PM
my sample sheet is in the webpage
https://authentification.site/files/21933078/rahul.xls
download this file and copy paste this macro in the vbeditor module of THIS file.
you must be already having separate files for each manager . suppose the manager's name is q then the file name will be something like this (the same format path manager's name and .xls)
D;\excel\q.xls
here "d:\excel\" is the path which I have indicated in the macro as
path = "d:\excel\"
change this statement to suit your path
if there is change in the filename the macro will not work.
the names in manager's file name and the name of the manager in column I of the main sheet should be exact -if there is spelling mistake there will be problem
the macro is
https://authentification.site/files/21933078/rahul.xls
download this file and copy paste this macro in the vbeditor module of THIS file.
you must be already having separate files for each manager . suppose the manager's name is q then the file name will be something like this (the same format path manager's name and .xls)
D;\excel\q.xls
here "d:\excel\" is the path which I have indicated in the macro as
path = "d:\excel\"
change this statement to suit your path
if there is change in the filename the macro will not work.
the names in manager's file name and the name of the manager in column I of the main sheet should be exact -if there is spelling mistake there will be problem
the macro is
Sub test()
Dim r As Range, r1 As Range, rmain As Range, c1 As Range
Dim path As String, man As String, dest As Range
path = "d:\excel\"
ThisWorkbook.Activate
Worksheets("sheet1").Activate
Set rmain = Range(Range("A1"), Range("a1").End(xlDown).End(xlToRight))
Set r = Range(Range("I1"), Range("I1").End(xlDown))
Set dest = Range("A1").End(xlDown).Offset(5, 0)
r.AdvancedFilter action:=xlFilterCopy, copytorange:=dest, unique:=True
Set r1 = Range("A1").End(xlDown).Offset(6, 0)
Set r1 = Range(r1, r1.End(xlDown))
For Each c1 In r1
man = Trim(c1.Value)
rmain.AutoFilter field:=9, Criteria1:=man
rmain.SpecialCells(xlCellTypeVisible).Copy
Workbooks.Open (path & man & ".xls")
ActiveWorkbook.Worksheets("sheet1").Range("A1").PasteSpecial
ActiveWorkbook.Save
ActiveWorkbook.Close
ThisWorkbook.Activate
Worksheets("sheet1").Activate
ActiveSheet.AutoFilterMode = False
Next c1
End Sub
Excellent code venkat.
I created using another code.
Dim thisWB As String
Dim newWB As String
thisWB = ActiveWorkbook.Name
On Error Resume Next
Sheets("tempsheet").Delete
On Error GoTo 0
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("h:h").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 <> Rows.Count 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(Rows.Count, 1).End(xlUp).Row
For suppno = 2 To lMaxSupp
Windows(thisWB).Activate
supName = Sheets("tempsheet").Range("A" & suppno)
If supName <> "" Then
Workbooks.Add
ActiveWorkbook.SaveAs supName
newWB = ActiveWorkbook.Name
Windows(thisWB).Activate
Sheets("Sheet1").Select
Cells.Select
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If
Selection.AutoFilter Field:=8, Criteria1:="=" & supName, _
Operator:=xlAnd, Criteria2:="<>"
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Rows("1:" & lastrow).Copy
Windows(newWB).Activate
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
the code is working, but i wanted to sort the column based on my requirement like mangager should be 1st, employee name should be in 2nd column for all work books.
And again i wanted to put some formulas in 2nd sheet the sum has to display in 1st sheet.
Please help me.
I created using another code.
Dim thisWB As String
Dim newWB As String
thisWB = ActiveWorkbook.Name
On Error Resume Next
Sheets("tempsheet").Delete
On Error GoTo 0
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("h:h").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 <> Rows.Count 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(Rows.Count, 1).End(xlUp).Row
For suppno = 2 To lMaxSupp
Windows(thisWB).Activate
supName = Sheets("tempsheet").Range("A" & suppno)
If supName <> "" Then
Workbooks.Add
ActiveWorkbook.SaveAs supName
newWB = ActiveWorkbook.Name
Windows(thisWB).Activate
Sheets("Sheet1").Select
Cells.Select
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If
Selection.AutoFilter Field:=8, Criteria1:="=" & supName, _
Operator:=xlAnd, Criteria2:="<>"
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Rows("1:" & lastrow).Copy
Windows(newWB).Activate
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
the code is working, but i wanted to sort the column based on my requirement like mangager should be 1st, employee name should be in 2nd column for all work books.
And again i wanted to put some formulas in 2nd sheet the sum has to display in 1st sheet.
Please help me.
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Apr 13, 2010 at 11:39 PM
Apr 13, 2010 at 11:39 PM
if your macro works it is ok. always there will be alternative methods or macros. Now as you are familiar with writing/recording macros try your sorting problem by RECORDING a macro and editing it. If there is a problem post back with file name sheet name and sorting column asceding or descending etc. for autofilter work there is no need to sort.
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Apr 14, 2010 at 06:08 AM
Apr 14, 2010 at 06:08 AM
where do you want to insert the formulas-in sheet 1 of each manager's file or original master file. whatever be enter the formula and see.
if it is in each of the manger's files then is it not possible to enter the formula after running the macro.give two examples based on my sample data.
if it is in each of the manger's files then is it not possible to enter the formula after running the macro.give two examples based on my sample data.
Yes Venkat, I wanted to add formulas in each managers file. (in sheet1 Cell C22=if name is Roy then amount is 100 else 150).
I know its not possible, but tell me is any alternate method for this.
Or else can we add the formulas in original sheet (sheet2) and paste the sheet2 in all managers file. and giving link to sheet1.
I know its not possible, but tell me is any alternate method for this.
Or else can we add the formulas in original sheet (sheet2) and paste the sheet2 in all managers file. and giving link to sheet1.
Didn't find the answer you are looking for?
Ask a question
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Apr 15, 2010 at 06:43 AM
Apr 15, 2010 at 06:43 AM
I have slightly modified the mcaro. check whether it does what you want
Sub test()
Dim r As Range, r1 As Range, rmain As Range, c1 As Range
Dim path As String, man As String, dest As Range
path = "d:\excel\"
ThisWorkbook.Activate
Worksheets("sheet1").Activate
Set rmain = Range(Range("A1"), Range("a1").End(xlDown).End(xlToRight))
Set r = Range(Range("I1"), Range("I1").End(xlDown))
Set dest = Range("A1").End(xlDown).Offset(5, 0)
r.AdvancedFilter action:=xlFilterCopy, copytorange:=dest, unique:=True
Set r1 = Range("A1").End(xlDown).Offset(6, 0)
Set r1 = Range(r1, r1.End(xlDown))
For Each c1 In r1
man = Trim(c1.Value)
rmain.AutoFilter field:=9, Criteria1:=man
rmain.SpecialCells(xlCellTypeVisible).Copy
Workbooks.Open (path & man & ".xls")
With ActiveWorkbook.Worksheets("sheet1")
.Range("A1").PasteSpecial
If Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) = "Roy" Then
.Range("c22") = 100
Else
.Range("c22") = 150
End If
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
ThisWorkbook.Activate
Worksheets("sheet1").Activate
ActiveSheet.AutoFilterMode = False
Next c1
End Sub
Apr 13, 2010 at 09:10 PM
Yes, In this excel almost 9 managers are there, they have 100 employess. now i wanted to create work book for all managers. i don't know how to create the in macro. Please help me.