Guest User

Untitled

a guest
Aug 19th, 2018
83
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.26 KB | None | 0 0
  1. ' CopyIfTrue()
  2. Dim Col As Range, Cell As Excel.Range, RowCount As Integer
  3. Dim nysheet As Worksheet
  4. Set nysheet = Sheets.Add()
  5. nysheet.Name = "T1"
  6.  
  7. Sheets("FemImplant").Select
  8. RowCount = ActiveSheet.UsedRange.Rows.Count
  9.  
  10. Set Col = Range("I2:I" & RowCount) 'Substitute with the range which includes your True/False values
  11. Dim i As Integer
  12. i = 1
  13.  
  14. For Each Cell In Col
  15. If Cell.Value = "True" Then
  16. Cell.Copy
  17. Sheets("T1").Select 'Substitute with your sheet
  18. Range("b" & i).Select
  19. ActiveSheet.Paste
  20.  
  21. 'Get sibling cell
  22.  
  23. Sheets("FemImplant").Select
  24. Dim thisRow As Integer
  25. thisRow = Cell.Row
  26. Dim siblingCell As Range
  27. Set siblingCell = Cells(thisRow, 2)
  28. siblingCell.Copy
  29. Sheets("T1").Select 'Substitute with your sheet
  30. Range("a" & i).Select
  31. ActiveSheet.PasteSpecial Paste:=xlPasteValues
  32.  
  33. Sheets("FemImplant").Select
  34. i = i + 1
  35. End If
  36. Next
  37.  
  38. ActiveSheet.Range("a" & i).PasteSpecial Paste = xlPasteValues
  39.  
  40. Option Explicit
  41.  
  42. Sub Sample()
  43. Dim rRange As Range
  44. Dim RowCount As Integer, i As Long
  45. Dim nysheet As Worksheet
  46.  
  47. On Error Resume Next
  48. Application.DisplayAlerts = False
  49. Sheets("T1").Delete
  50. Application.DisplayAlerts = True
  51. On Error GoTo 0
  52.  
  53. Set nysheet = Sheets.Add()
  54. nysheet.Name = "T1"
  55.  
  56. With Sheets("FemImplant")
  57. RowCount = .Range("I" & Rows.Count).End(xlUp).Row
  58.  
  59. .AutoFilterMode = False
  60.  
  61. Set rRange = .Range("I2:I" & RowCount)
  62.  
  63. With rRange
  64. .AutoFilter Field:=1, Criteria1:="True"
  65.  
  66. .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
  67. nysheet.Range("B1").PasteSpecial xlPasteValues
  68.  
  69. .Offset(1, -7).SpecialCells(xlCellTypeVisible).Copy
  70. nysheet.Range("A1").PasteSpecial xlPasteValues
  71. End With
  72.  
  73. .AutoFilterMode = False
  74. End With
  75. End Sub
  76.  
  77. ' CopyIfTrue()
  78. Dim Col As Range, Cell As Excel.Range, RowCount As Integer
  79. Dim nysheet As Worksheet, shtFI As Worksheet
  80.  
  81. Set shtFI = Sheets("FemImplant")
  82. Set nysheet = Sheets.Add()
  83. nysheet.Name = "T1"
  84.  
  85. RowCount = shtFI.UsedRange.Rows.Count
  86. Set Col = shtFI.Range("I2:I" & RowCount)
  87.  
  88. Dim i As Integer
  89. i = 1
  90.  
  91. For Each Cell In Col.Cells
  92. If Cell.Value = "True" Then
  93. Cell.Copy nysheet.Range("B" & i)
  94. nysheet.Range("A" & i).Value = _
  95. shtFI.Cells(Cell.Row, 2).Value
  96. i = i + 1
  97. End If
  98. Next
  99.  
  100. Sub ExtractData()
  101.  
  102. Dim selectedRange As Range ' Range to check
  103. Dim Cell As Range
  104. Dim iTotalRows As Integer ' Selected total number of rows
  105. Dim i As Integer ' marker to identify which row to paste in new sheet
  106.  
  107. Dim shtNew As Worksheet
  108. Dim shtData As Worksheet
  109.  
  110. Set shtData = Sheets("data")
  111. Set shtNew = Sheets.Add()
  112. shtNew.Name = "Analyzed data"
  113.  
  114. iTotalRows = shtData.UsedRange.Rows.count
  115. Set selectedRange = shtData.Range("F2:F" & iTotalRows)
  116.  
  117. i = 1
  118.  
  119. ' Check the selected column value one by one
  120. For Each Cell In selectedRange.Cells
  121.  
  122. If Cell.Value = "True" Then
  123. Cell.Copy shtNew.Range("A" & i)
  124.  
  125. ' Copy the brand to column B in "Analyzed data" sheet
  126. shtNew.Range("B" & i).Value = _
  127. shtData.Cells(Cell.Row, 2).Value
  128. i = i + 1
  129. End If
  130.  
  131. Next ' Check next cell in selected range
  132.  
  133. End Sub
Add Comment
Please, Sign In to add comment