excel - Cut and paste range repeatedly (with varying rows determined by a specific string)

Question

There is a data set consisting of subsets and contained vertically in excel sheet. Each subset has different row length but the same column length. Each subset has an indicator keyword "group1" in Column"A".

I want each data set to be horizontally aligned next to each other.

For example, say the whole data in a range (A1:M3084) consist of various blocks of x rows and 13 columns. The first block is in (A1:M124), the second data block is in (A125:M250), and so on. I want to cut the second block and paste it next to the first block, leaving a column space (Column"N") in between, to (O1:AA248). Then, repeat the process until the end of the row, keep pasting the next block (A241: M372) next to the second block, to (AC1:AO372), and so forth...

For this, I need to find the row number that contains "group1", which is at the start of subset (top-left cell), and use the (row_number -1) as a blocksize, and repeat the process.

I need to loop through finding each blocksize, and then copy-paste the block next to each other (horizontally).

I have been working on the code but without success (and not sure how to loop these 2 requirements).

Thank you.

Dim rowCount As Integer, colCount As Integer
Dim blockSize As Variant
Dim colOffset As Variant
Dim wordCount As Integer
  
'Find how many occurance of "group1"
wordCount = Application.WorksheetFunction.CountIf(ActiveSheet.Cells, "group1")
 
 'Find each block size by looping
        Dim FindRow As Variant
        Do Until FindRow Is Nothing
            FindRow = Columns("A").Find(What:="group1").Row  ' If text is "group1".
            If FindRow > 1 Then 'ignore the 1st block ("group1" inrow(1))
            blockSize = FindRow - 1   'row_number-1 = blocksize
          
        'count rows and columns with data
        rowCount = Range("A1").CurrentRegion.Rows.Count
        colCount = Range("A1").CurrentRegion.Columns.Count
                                     
       'move the 2nd block and paste it next to the 1st block, delete the block in origin, and continue until the last block
       For i = 1 To wordCount
        'column number to move
        colOffset = i * (colCount + 1)
                
        'move to next column block (@row1)  = data in the block @ orign
        Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(0, colOffset).Value2 = Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(blockSize * i, 0).Value2 'Value2 returns cerial number
        'clear the block in origin
        Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(blockSize * i, 0).ClearContents
   
        Loop
        Next i

End If

question from:https://stackoverflow.com/questions/65939096/cut-and-paste-range-repeatedly-with-varying-rows-determined-by-a-specific-strin

Answer 1

After so many trials and errors, I could figure out how to do the above with vba code. The only draw back is that I get many "#N/A" after below the moved blocks from the 3rd block onward, which I do not want. Another problem I encountered was that "FindRow" looks the 1st row only at the end when I want it first.

Dim rowCount As Integer, colCount As Integer, wordCount As Integer, firstFound As Integer
Dim FindRow As Range
Dim previousFound As Integer, nextFound As Integer, blockSize As Integer
Dim count As Integer, colOffset As Integer

    rowCount = Range("A1").CurrentRegion.Rows.count  'count row number
    colCount = Range("A1").CurrentRegion.Columns.count 'count column number
    wordCount = WorksheetFunction.CountIf(Range("A:A"), "*group: 1*") 'count occurance of a keyword in ""
    'MsgBox (wordCount) 'MsgBox for checking purpose
            
'Find row number of "group1" (-1 = blocksize)
With ActiveSheet.Range("A1:A" & rowCount)
Set FindRow = .Find(What:="group: 1", LookAt:=xlPart)
If Not FindRow Is Nothing Then
    firstFound = FindRow.Row   'get the first found row-> somehow, the first row "1" is skipped..
         
 
    count = 0
    Do
    count = count + 1 'count loops
    previousFound = FindRow.Row
    
    Set FindRow = .FindNext(FindRow)
       'for the last block (since no nextFound) 
       If count = 11 Then
       nextFound = rowCount + 1
       Else
       nextFound = FindRow.Row
       End If
    
    blockSize = nextFound - previousFound
   ' MsgBox (blockSize)   'for checking purpose
   
   
            If FindRow Is Nothing Then Exit Do
    
     colOffset = count * (colCount + 1)
              
     'destination range =block range at the origin
    Range(Cells(1, 1), Cells(previousFound, colCount)).Offset(0, colOffset).Value2 = _
    Range(Cells(previousFound, 1), Cells(nextFound - 1, colCount)).Value2
    Range(Cells(previousFound, 1), Cells(nextFound - 1, colCount)).ClearContents
            
    Loop Until FindRow.Row = 1 'usually should be "first Found" but since 1st row is ignored..
       
       
End If
End With