scan column for a variable and select the row

Question

i have a big datasheet and i need a code to scan a column( screenshot "selection") for a x or add a checkbox. If there is a x the row should be selected and some of the columns should be transposed into a new table.

i have an code to scan the column for x and have the code to transpose the columns i need but i need some help to combine these codes together.

scan column(selection) for an x and select the rows
transpose some cells(selected colums) of the selected row into a new table ( i have the code)

For Each c In Range("K:K")
 ' If c.Value = "x" Then
  
  ' MsgBox "x found at " & c.Address
  'End If
'Next c

Sub TransposeColumn2Row()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim Myarray() As Variant
Dim LastRow As Integer, LastColumn As Integer
Dim StartCell As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim i As Long
Dim j As Long

Set StartCell = ws1.Range("A1")
LastRow = ws1.Cells(ws1.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws1.Cells(StartCell.Row, ws1.Columns.Count).End(xlToLeft).Column

'copy specific columns into worksheet 2

j = 1
For i = 1 To LastColumn Step 1
    Select Case i
        Case 1, 4, 8, 6, 9, 3, 5 'target columns to copy
            With ws1
                Myarray() = .Range(.Cells(1, i), .Cells(LastRow, i)).Value
            End With
            
            With ws2
                .Range(.Cells(j, 1), .Cells(j, LastRow)) = Application.WorksheetFunction.Transpose(Myarray())
            End With
            j = j + 1
        Case Else
    End Select
Next i
    
Erase Myarray()

End Sub

Help me combine these codes Thx in advance

user_14909621 · Answer

If this is a one-time task, I would use a formula:

=TRANSPOSE(FILTER(FILTER(A:J, {1,0,1,1,1,1,0,1,1,0}), K:K="x"))

The exact notation depends on local settings (the formula looks different in my case). But this one can be used with Evaluate in VBA. Here we mark columns to copy with an array {1,0,1,1,1,1,0,1,1,0} and then filter the rows with "x" in the column K.

As for VBA, this case would be easier to solve with ListObject in general case. But we can also Intersect columns of interest with marked rows and .Copy toDestination:

Sub CopyMarked()
Dim Source As Worksheet
Dim Destination As Worksheet
Dim Data As Range
Dim Criteria As Range
    Set Source = ActiveSheet
    Set Destination = Worksheets.Add(After:=Source)
    Set Data = Source.Range("A:A, C:F, H:I")       ' columns 1,4,8,6,9,3,5
    Set Criteria = Source.Columns("K").SpecialCells(xlCellTypeConstants).EntireRow
    Intersect(Data, Criteria).Copy 
    Destination.Range("a1").PasteSpecial xlPasteValues, Transpose:=True
End Sub

scan column for a variable and select the row

1 Answers