macro to copy certain data Closed

Question

Hello, 

I regret to say that I missed using hello and other polite words in my earlier post. I do respect the people behind the forum. I know that the volunteers are spending lot of time in solving the problems of the readers. I once again apologies for the mistake.  

I need some help from the forum. I am not familiar with macro. 
There are two sheets in a workbook. The first Sheet is "COLLECTIONS" which will have full data in columns and rows. (In Sheet "COLLECTIONS" rows and columns are fixed). Now i want to copy from sheet "COLLECTION" to Sheet "PENDING-LIST" if the value is there in column "J" in sheet "COLLECTION". The second conditions I would to have is that only certain columns ("E","G", "I" & "J")are only to be copied and in the end of the sheet "pending list" the totals for each column will appear.

I am uploading test file for your convenience. The Uploaded sheet two (PENDING LIST ) is done without macro. http://www.speedyshare.com/files/28902606/test.XLS

I request someone to help me in this regard.

Thanking you

Kumar




Configuration: Windows XP / Firefox 5.0

venkat1926 · Answer

try this macro (seond macro to CLEAR the pending list sheet cells)

Public Sub INSERTDASH()
   Dim r As Range, c As Range, k As Integer, m As Integer, n As Integer
   
   With Worksheets("collections")
   k = .Range("A2").End(xlDown).Row
   Set r = Range(.Range("A2"), .Cells(k, "J"))
   r.AutoFilter field:=Range("J2").Column, Criteria1:=">=1"
   r.Cells.SpecialCells(xlCellTypeVisible).Copy
   With Worksheets("pending-list")
   .Range("A1").PasteSpecial
   '.Range("C1:D1").EntireColumn.Delete
   '.Range("F1").EntireColumn.Delete
   '.Range("H1").EntireColumn.Delete
      
 Union(.Range("C1:D1"), .Range("F1"), .Range("H1")).EntireColumn.Delete
      
      
      m = .Cells(1, Columns.Count).End(xlToLeft).Column
   For n = 3 To m
   .Cells(1, n).End(xlDown).Offset(1, 0) = WorksheetFunction.Sum(Range(.Cells(2, n), .Cells(2, n).End(xlDown)))
   Next n
   End With
   r.AutoFilter
   End With
   End Sub
   
Sub undo()
Worksheets("pending-list").Cells.Clear
End Sub

Kumar · Answer

Hello Venkat

Thanks for the macro. 
The macro is working nicely on test.xls file which was uploaded to you, when i am copying the same macro in the actual file the macro is not working properly some data is coming in "pending-list" sheet but the data is not correct.  The file uploaded is only raw data, but the actual file is having several sheets and the sheet"Collections" is derived from another sheet. I think the reason may be due to formulas in the "Collection" sheet. I tried same "collection" sheet without formulas and it is working. The actual file very big and i may not be upload it.  
One more point i wld like request you to put two line in the totals row with heading as "Totals".  
I hope i am not troubling you.

Regards

Kumar

venkat1926 · Answer

i have slightly modified the macro. This will take care of the formulas.   i do not understand "One more point i wld like request you to put two line in the totals row with heading as "Totals".   a;particularly two lines  

Public Sub INSERTDASH()  
   Dim r As Range, c As Range, k As Integer, m As Integer, n As Integer  
     
   With Worksheets("collections")  
   k = .Range("A2").End(xlDown).Row  
   Set r = Range(.Range("A2"), .Cells(k, "J"))  
   r.AutoFilter field:=Range("J2").Column, Criteria1:=">=1"  
   r.Cells.SpecialCells(xlCellTypeVisible).Copy  
   With Worksheets("pending-list")  
   .Range("A1").PasteSpecial , Paste:=xlPasteValues  
   '.Range("C1:D1").EntireColumn.Delete  
   '.Range("F1").EntireColumn.Delete  
   '.Range("H1").EntireColumn.Delete  
        
 Union(.Range("C1:D1"), .Range("F1"), .Range("H1")).EntireColumn.Delete  
        
        
      m = .Cells(1, Columns.Count).End(xlToLeft).Column  
   For n = 3 To m  
   .Cells(1, n).End(xlDown).Offset(1, 0) = WorksheetFunction.Sum(Range(.Cells(2, n), .Cells(2, n).End(xlDown)))  
   Next n  
   .Range("A1").End(xlDown).Offset(1, 0) = "total"  
   End With  
   r.AutoFilter  
   End With  
   End Sub
     
Sub undo()  
Worksheets("pending-list").Cells.Clear  
End Sub

Kumar · Answer

Hello Venkat,

The macro is working. 
I tried to modify your code for retaining the "Number Formats" and "Columns Widths" and pasting the values only. The code i added is as follows " .Range("A1").PasteSpecial , Paste:=xlPasteValues , Paste:=xlpastenumberformat, Paste:=xlpastecolumnwidth". Please tell me whether it is correct or not.

One more thing is when i am updating "collection" sheet and running the macro, in the "pending-list" old data is not clearing. I tried changing code it is not working.  I think all rows in "pending-list" sheet should be deleted before updating second time.
Kindly guide me to correct the particular two points. 
With regards

Kumar

venkat1926 · Answer

i would rather not do the ", Paste:=xlpastenumberformat, Paste:=xlpastecolumnwidth".  remove this 
because the autofit (column width) and number format is for all the columns 

write another small macro ( I am of the view that instead of writing an omnuibus macro split into different subs 

you have not said what number format you want. you want the numbers as integers or with two decimal places. I took it you need it as integers.


Sub cosmetics()
Dim j As Integer, k As Integer
With Worksheets("pending-list")
Range(.Range("A1"), .Range("A1").End(xlToRight)).EntireColumn.AutoFit
.Cells.NumberFormat = "0"
End With
End Sub


wither of the two actions you can do
 1. after running "insertdash" you can run "cosmetics" 
or 
2. you add a line cosmetics (with no brackets) one line above "end sub" in the macro "insertdash" which means same things as 1 above.

Kumar · Answer

Hello Venkat

Sorry for bothering u on the same subject.
I tried to add a line cosmetics (with no brackets) one line above "end sub" in the macro "insertdash", when i am joying and when i am going to next line, the brackets are coming automatically hence i could not join the codes. Is there any way to join two codes (undo & Cosmetics) into one macro. 
1. Regarding your query with reference to the number format i mean Accounting format without decimal.
2. Second format i need is for heading of columns in the pending-list sheet. (Same  appearing in "Collection sheet in my test.xls file.

Regards

Kumar

venkat1926 · Answer

I am sending the complete set of macros.  Instead of accountancy format I am using currency format which looks more elegant.  You park all the three macro in the same module of your vb editor. 

Public Sub INSERTDASH() 
   Dim r As Range, c As Range, k As Integer, m As Integer, n As Integer 
    
   With Worksheets("collections") 
   k = .Range("A2").End(xlDown).Row 
   Set r = Range(.Range("A2"), .Cells(k, "J")) 
   r.AutoFilter field:=Range("J2").Column, Criteria1:=">=1" 
   r.Cells.SpecialCells(xlCellTypeVisible).Copy 
   With Worksheets("pending-list") 
   .Range("A1").PasteSpecial , Paste:=xlPasteValues 
   '.Range("C1:D1").EntireColumn.Delete 
   '.Range("F1").EntireColumn.Delete 
   '.Range("H1").EntireColumn.Delete 
       
 Union(.Range("C1:D1"), .Range("F1"), .Range("H1")).EntireColumn.Delete 
       
       
      m = .Cells(1, Columns.Count).End(xlToLeft).Column 
   For n = 3 To m 
   .Cells(1, n).End(xlDown).Offset(1, 0) = WorksheetFunction.Sum(Range(.Cells(2, n), .Cells(2, n).End(xlDown))) 
   Next n 
   .Range("A1").End(xlDown).Offset(1, 0) = "total" 
   End With 
   r.AutoFilter 
   End With 
   cosmetics 
   End Sub

    
Sub undo() 
Worksheets("pending-list").Cells.Clear 
End Sub


Sub cosmetics() 
Dim j As Integer, k As Integer 
With Worksheets("pending-list") 
Range(.Range("A1"), .Range("A1").End(xlToRight)).EntireColumn.AutoFit 
.Cells.NumberFormat = "$#,##0" 
.Range("A1").End(xlDown).EntireRow.Insert 
.Rows(Cells(Rows.Count, "A").End(xlUp).Row).Font.Bold = True 
.Range("A1").End(xlToRight).EntireColumn.Font.Bold = True 

End With 
End Sub

Kumar · Answer

Dear Venkat 

There is small malfunction in the code. 
When i run undo macro, data is being  erased and after erasing if i am running  Insertdash macro column width in pending-list is not coming properly. When data in pending-list is deleted manually also the column format is not coming in the second instant. 
In your recent updated macro you have included all the three codes in insertdash macro. My feeling is that first it should delete all records in pending-list sheet then only pending- list should be updated with cosmetics.
Kindly advice me in this regard.

Thanking you
Kumar

venkat1926 · Answer

1. run insertdash only after running undo 

alternatively  

2. introduce a line  
undo  
below the dim statements in the macro insertdash 


personally I would prefer alternate 1 but you can choose.

Macro to copy certain data

9 responses

Similar discussions

Subscribe To Our Newsletter!