By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
434,882 Members | 2,460 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 434,882 IT Pros & Developers. It's quick & easy.

Duplicate data in excel sheet and filter the data according to the name

kirubagari
100+
P: 158
Hai experts,

How to duplicate the data from 1 excel sheet to another excel sheet 2.
Lets say

Expand|Select|Wrap|Line Numbers
  1. Name                   Voucher Value       Voucher Number     
  2. lee                      300.00                58419-58421
  3. meena                      300.00                58422-58424
  4. Tan                        300.00                58425-58427 

I would like to filter the data accoring to the voucher number and the result is like this in excel
Expand|Select|Wrap|Line Numbers
  1. 58419    lee      300.00    58419-58421
  2. 58420    lee      300.00    58419-58421
  3. 58421    lee      300.00    58419-58421
  4. 58422    meena    300.00    58422-58424
  5. 58423    meena    300.00    58422-58424
  6. 58424    meena    300.00    58422-58424
  7. 58425    Tan      300.00    58425-58427
  8. 58426    Tan      300.00    58425-58427
  9. 58427    Tan      300.00    58425-58427

I would like to filter the 1st sheet (input data) into second sheet in VBA MACRO.


The coding as below



Expand|Select|Wrap|Line Numbers
  1. Sub Duplicate
  2.   Dim oDoc As Object, oSheet As Object, oCell As Object, oCell2 As Object, oCell3 As Object, oString As String
  3.   Dim oCells As Object
  4.   Dim oCursors As Object
  5.   Dim aAddresss As Variant
  6.  
  7.   REM Define what sheet to used
  8.   oDoc   =ThisComponent
  9.   oSheet =oDoc.CurrentController.ActiveSheet
  10.   oSheet2=oDoc.Sheets.getByIndex(1) '2nd Sheet
  11.  
  12.   REM Get the value of the LastUsedRow & LastUsedColumn
  13.   oCells = oSheet.GetCellbyPosition(0, 0)
  14.   oCursors = oSheet.createCursorByRange(oCells)
  15.   oCursors.GotoEndOfUsedArea(True)
  16.   aAddress = oCursors.RangeAddress
  17.   LastUsedRow = aAddress.EndRow
  18.   LastUsedColumn = aAddress.EndColumn
  19.  
  20.   'Row2Print=row printed row
  21.   'l=last used row in Sheet2
  22.  
  23.  
  24.   For i=0 to LastUsedRow
  25.    'oCell2=ThisComponent.CurrentSelection.getCellAddress 'Currently Selected Cell
  26.    oSelect=ThisComponent.CurrentSelection.getRangeAddress
  27.    oString = oSheet.GetCellbyPosition(oSelect.StartColumn, i).getString() 'IMPORTANT (Need Revision)
  28.    'getCellByPosition(Column,Row)
  29.    oRight = Val(Right(oString,Len(oString)-InStr(1, oString, "-")))
  30.    oLeft =  Val(Left(oString,Len(oString)-InStr(1, oString, "-")))
  31.    Row2Print = oRight - oLeft
  32.    oRangeOrg = oSheet.getCellRangeByName("A"&(i+1)&":O"&(i+1)).RangeAddress   ' copy range
  33.  
  34.     REM Begin Pasting the Value 
  35.     For j=0 to Row2Print
  36.    k=k+1
  37.      oRangeCpy = oSheet2.getCellRangeByName("B"&k).RangeAddress ' insert range
  38.      oCellCpy = oSheet2.getCellByPosition(oRangeCpy.StartColumn,oRangeCpy.StartRow).CellAddress ' insert position
  39.      oSheet.CopyRange(oCellCpy, oRangeOrg) ' copy
  40.     Next
  41.  
  42.    'oSheet2=oDoc.Sheets.getByIndex(1) '2nd Sheet 
  43.    'oCells = oSheet2.GetCellbyPosition(0, 0)
  44.    'oCursors = oSheet2.createCursorByRange(oCells)
  45.    'oCursors.GotoEndOfUsedArea(True)
  46.    'aAddress = oCursors.RangeAddress
  47.    'LastUsedRow = aAddress.EndRow
  48.    'LastUsedColumn = aAddress.EndColumn 
  49.  
  50.     For l=0 to Row2Print
  51.      oCell4=oSheet2.getCellByPosition(0,m) 'A1
  52.      oCell4.setString(oLeft)
  53.      oLeft=oLeft+1
  54.      m=m+1
  55.     Next 
  56.   Next i
  57.   'oCell.NumberFormat=2   '23658.00
  58.   'oCell.SetValue(12345)
  59.   'oCell.SetString("oops")
  60.   'oCell.setFormula("=FUNCTION()")
  61.   'oCell.IsCellBackgroundTransparent = TRUE
  62.   'oCell.CellBackColor = RGB(255,141,56)
  63. End Sub
  64.  
  65. Function GetLastUsedRow(oSheets as Object) as Integer
  66. Dim oCells As Object
  67. Dim oCursors As Object
  68. Dim aAddresss As Variant
  69.  
  70. oCells = oSheets.GetCellbyPosition(0, 0)
  71. oCursors = oSheets.createCursorByRange(oCells)
  72. oCursors.GotoEndOfUsedArea(True)
  73. aAddresss = oCursors.RangeAddress
  74. GetLastUsedRow = aAddresss.EndRow
  75. End Function
  76.  
  77. Function GetLastUsedColumn(oSheet as Object) as Integer
  78.   Dim oCell As Object
  79.   Dim oCursor As Object
  80.   Dim aAddress As Variant
  81.   oCell = oSheet.GetCellbyPosition( 0, 0 )
  82.   oCursor = oSheet.createCursorByRange(oCell)
  83.   oCursor.GotoEndOfUsedArea(True)
  84.   aAddress = oCursor.RangeAddress
  85.   GetLastUsedColumn = aAddress.EndColumn
  86. End Function
  87.  
  88. Sub SelRow()
  89.   Dim oSheet
  90.   Dim oRow
  91.   oSheet = ThisComponent.getSheets().getByIndex(0)
  92.   oRow = oSheet.getRows().getByIndex(2)
  93.   ThisComponent.getCurrentController().select(oRow)
  94. End Sub
  95.  
  96. Sub CopySpreadsheetRange
  97.   oSheet1 = ThisComponent.Sheets.getByIndex(0)    ' sheet no 1, original
  98.   oSheet2 = ThisComponent.Sheets.getByIndex(1)    ' sheet no 2
  99.  
  100.   oRangeOrg = oSheet1.getCellRangeByName("A1:C10").RangeAddress   ' copy range
  101.   oRangeCpy = oSheet2.getCellRangeByName("A1:C10").RangeAddress   ' insert range
  102.  
  103.   oCellCpy = oSheet2.getCellByPosition(oRangeCpy.StartColumn,_
  104.     oRangeCpy.StartRow).CellAddress ' insert position
  105.  
  106.   oSheet1.CopyRange(oCellCpy, oRangeOrg)                  ' copy
  107. End Sub
  108. '----------------------------------------------------------------------------------------
  109.  
  110. Function IsSpreadsheetDoc(oDoc) As Boolean
  111.   Dim s$ : s$ = "com.sun.star.sheet.SpreadsheetDocument"
  112.   IsSpreadsheetDoc = oDoc.SupportsService(s$)
  113. End Function
  114.  
  115. Sub checking( )
  116.   MsgBox IsSpreadsheetDoc(thisComponent)
  117. End Sub
  118.  
  119. Sub ExampleGetValue
  120.   Dim oDoc As Object, oSheet As Object, oCell As Object
  121.   oDoc=ThisComponent
  122.   oSheet=oDoc.Sheets.getByName("Sheet1")
  123.   oCell=oSheet.getCellByposition(0,0) 'A1
  124.   Rem a cell's contents can have one of the three following types:
  125.   Print oCell.getValue()
  126.   'Print oCell.getString()
  127.   'Print oCell.getFormula()
  128. End Sub
  129.  
  130. Sub SelectedCells 
  131.   oSelect=ThisComponent.CurrentSelection.getRangeAddress
  132.   oSelectColumn=ThisComponent.CurrentSelection.Columns
  133.   oSelectRow=ThisComponent.CurrentSelection.Rows
  134.  
  135.   CountColumn=oSelectColumn.getCount
  136.   CountRow=oSelectRow.getCount
  137.  
  138.   oSelectSC=oSelectColumn.getByIndex(0).getName
  139.   oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName
  140.  
  141.   oSelectSR=oSelect.StartRow+1
  142.   oSelectER=oSelect.EndRow+1
  143.   NoCell=(CountColumn*CountRow)
  144.  
  145.   If CountColumn=1 AND CountRow=1 Then
  146.     MsgBox("Cell " + oSelectSC + oSelectSR + chr(13) + "Cell No = " + NoCell,, "SelectedCells")
  147.   Else
  148.     MsgBox("Range(" + oSelectSC + oSelectSR + ":" + oSelectEC + oSelectER + ")" + chr(13) + "Cell No = " + NoCell,, "SelectedCells") 
  149.   End If
  150. End Sub
  151.  
  152. Sub Analize
  153.   sSum="=SUM("+GetAddress+")"
  154.   sAverage="=AVERAGE("+GetAddress+")"
  155.   sMin="=MIN("+GetAddress+")"
  156.   sMax="=MAX("+GetAddress+")"
  157.   CellPos(7,6).setString(GetAddress)
  158.   CellPos(7,8).setFormula(sSum)
  159.   CellPos(7,8).NumberFormat=2
  160.   CellPos(7,10).setFormula(sAverage)
  161.   CellPos(7,10).NumberFormat=2
  162.   CellPos(7,12).setFormula(sMin)
  163.   CellPos(7,12).NumberFormat=2
  164.   CellPos(7,14).setFormula(sMax)
  165.   CellPos(7,14).NumberFormat=2
  166. End sub
  167.  
  168. Function GetAddress  'selected cell(s)
  169.   oSelect=ThisComponent.CurrentSelection.getRangeAddress
  170.   oSelectColumn=ThisComponent.CurrentSelection.Columns
  171.   oSelectRow=ThisComponent.CurrentSelection.Rows
  172.  
  173.   CountColumn=oSelectColumn.getCount
  174.   CountRow=oSelectRow.getCount
  175.  
  176.   oSelectSC=oSelectColumn.getByIndex(0).getName
  177.   oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName
  178.  
  179.   oSelectSR=oSelect.StartRow+1
  180.   oSelectER=oSelect.EndRow+1
  181.   NoCell=(CountColumn*CountRow)
  182.  
  183.   If CountColumn=1 AND CountRow=1 then  
  184.     GetAddress=oSelectSC+oSelectSR  
  185.   Else  
  186.     GetAddress=oSelectSC+oSelectSR+":"+oSelectEC+oSelectER 
  187.   End If
  188. End Function
  189. Function CellPos(lColumn As Long,lRow As Long)
  190.   CellPos= ActiveSheet.getCellByPosition (lColumn,lRow)
  191. End Function
  192. Function ActiveSheet
  193.   ActiveSheet=StarDesktop.CurrentComponent.CurrentController.ActiveSheet
  194. End Function
  195. Sub DeleteDbRange(sRangeName As String)    
  196.   oRange=ThisComponent.DatabaseRanges
  197.   oRange.removeByName (sRangeName)
  198. End Sub 

KINDLY HELP ME SINCE THE CODING NOT WORKING INTEMETINLY..NEED HELP!!
Sep 22 '10 #1
Share this Question
Share on Google+
1 Reply


Expert 100+
P: 1,221
Wrong forum, I think you want the Excel forum.

Jim
Sep 22 '10 #2

Post your reply

Sign in to post your reply or Sign up for a free account.