Copy rows according to value of cells selected according to the value of other cells

[Aure]

Hello everyone,

I start by saying that I have clear in my mind what I want to achieve, but I have a very limited knowledge of VBA and therefore cannot write a working code.

What I need is a macro able to operate on an Excel file with 3 sheets ("Selection", "Dataset", and "Output") and follow these steps:

0. The user can place the X where he needs in the "Selection" sheet, then press a button to activate the macro.

1. Check if cell C3 of sheet "Selection" has been marked with a X.
2. If not, start the macro again, but for the following row (so in cell C4).
3. If yes, memorize the first 2 characters of cell A3 (in this example, "A1")
4. Go to sheet "Dataset"
5. Select all rows with code starting with the momorized characters (in this example, "A1")
6. Copy the rows
7. Go to sheet "Output"
8. Paste the rows underneath the title
9. Go to sheet "Selection"
10. Start the macro again for the following row

This is needed so that the user can just select a few categories and instantly produce a report with all the sub-category rows.
In a previous experiment I wrote some simple macros for each category, but that's quite inefficient and also I would need to always specify the row numbers in advance.

Sub Macro_Test()
Sheets("Dataset").Select
Rows("2:11").Select
Selection.Copy
Sheets("Output").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub

I think the steps I planned are a smarter way to approach the problem, but I am not able to write code that complicated

Can anyone give me some suggestions/help?

Thanks in advance!

[p45cal]

In the attached:

Sub blah()
Dim Codes(), RngToCopy As Range
'bring values of the Selection sheet table into memory (an array):
With Sheets("Selection")
  SelectionVals = Range(.Range("A3"), .Cells(.Rows.Count, "A").End(xlUp).Offset(, 2))
End With
'create an array of 2-character codes according to 'x' (upper or lower case):
For i = 1 To UBound(SelectionVals)
  If UCase(Application.Trim(SelectionVals(i, 3))) = "X" Then
    Count = Count + 1
    ReDim Preserve Codes(1 To Count)
    Codes(Count) = Left(Trim(SelectionVals(i, 1)), 2)
  End If
Next i
'determine cells to copy:
If IsEmpty(Count) Then    'means no matching codes/xs then clear the Output sheet data, so just clear the data from the Output sheet:
  With Sheets("Output")
    .Range("A4:A" & Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row)).Resize(, 4).Clear    ' clear the data from the Output sheet
    Application.Goto .Range("A1")    ' go to the Output sheet
  End With
Else    'there are some codes so process them:
  With Sheets("Dataset")
    Set CodesColm = Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp))    'column A (Codes) of the Dataset sheet with values.
    For Each codecell In CodesColm.Cells
      For i = 1 To UBound(Codes)    'run through each of the 2-character codes…
        If Left(Trim(codecell.Value), 2) = Codes(i) Then    'checking if they're the same as left 2 characters of the Dataset sheet's codes in column A…
          If RngToCopy Is Nothing Then Set RngToCopy = codecell.Resize(, 4) Else Set RngToCopy = Union(RngToCopy, codecell.Resize(, 4))    'if they are add the 4-column width row to the range to be copied.
        End If
      Next i
    Next codecell
  End With
  With Sheets("Output")
    If Not RngToCopy Is Nothing Then    'check to see that at least one row is to be copied
      .Range("A4:A" & Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row)).Resize(, 4).Clear    ' clear the data from the Output sheet
      RngToCopy.Copy .Range("A4")    'copy the data
      Application.Goto .Range("A1")    ' go to the Output sheet but only if data there has been updated.
    End If    '
  End With
End If
End Sub

I may look at other ways later (Advanced Filter, Power Query, pivot table)

[p45cal]

Power Query version.

[p45cal]

Pivot table version.
Added column to data set.
Selection sheet not used.
Make selection from slicer on Output sheet, using usual combination of Ctrl and mouse-click to select non-contiguous values.
No macros.

[p45cal]

If you've got Office 365 with FILTER, BYROW and LAMBDA sheet functions available to you the attached works by putting a single cell formula in cell A4 of the Output sheet.

[p45cal]

If you have a version of Excel with the sheet function FILTER available to you, then the attached has an advanced filter method of extracting the data. It uses cells I1:I2# on the Output sheet as a criterion range for Advanced Filter.

[Aure]

Hi p45cal,

Thank you so much for providing all these options, you are amazing!

I'll try all of them and see which one suits my needs the best

[p45cal]

cross posted at https://www.excelforum.com/excel-pro...her-cells.html