daily pastebin goal
87%
SHARE
TWEET

Untitled

a guest Aug 19th, 2018 50 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top