Need macro to move data from a cell into a new row

[havoc531]

Hello MrExcel forum. I'm a long time reader but first time poster.

I have an issue with groups of data in a row, that I need to copy into a new row beneath the original. I need a formula or VBA that will perform this function:
If any data is present in columns AG-AK, then copy that data into a new row below, into cells AB-AF. Also copy column B (this data is always present, it is the name of the project data contained in the original row)
If any data is present in columns AL-AP, then copy that data into another new row below, into cells AB-AF. Also copy column B (this data is always present, it is the name of the project data contained in the original row)

Let me know if this is unclear. Thanks in advance for the help!

 

[ShawnPCooke]

Is this operation being done on multiple rows of data at the same time? In other words, are the rows under the data you want to copy already blank, or do we need to insert extra rows to give them room?

 

[havoc531]

Is this operation being done on multiple rows of data at the same time? In other words, are the rows under the data you want to copy already blank, or do we need to insert extra rows to give them room?

It is being done on multiple rows at the same time, so we do need to insert extra rows beneath.

 

[ShawnPCooke]

This ought to do it. You'll have to change the lngFirstDataRow and lngLastDataRow variables in the 'Initialization section to correspond to the first and last rows of your data. (Or rather, the first and last rows that you want the program to look at.) Otherwise, it's pretty straightforward. Let me know if you have any questions.

Public Sub ShiftData()

    'Declarations
    Dim wsData As Worksheet
    
    Dim rngCopy As Range
    
    Dim i As Long               'Loop variable
    Dim j As Long               'Loop variable
    
    Dim lngFirstDataRow As Long
    Dim lngLastDataRow As Long
    
    Dim boolDataFound As Boolean    'True or false value
    
    
    'Initialization
    Set wsData = ActiveSheet
    lngFirstDataRow = 2         'Replace with your own value - row where the data starts
    lngLastDataRow = 100        'Replace with your own value - row where the data ends
    
    
    'Loop from the bottom to top.  Why?  Because when we insert
    'rows, it will shift stuff down.
    For i = lngLastDataRow To lngFirstDataRow Step -1
    
        'Check columns AL - AP for data
        boolDataFound = False
        For j = 38 To 42        'AL is the 38th column, AP the 42nd
            
            'If it's not blank...
            If Not wsData.Cells(i, j).Text = "" Then
                
                '...then there is data.  Change the boolean to TRUE and exit the for loop
                boolDataFound = True
                Exit For
            End If
        Next j
        
        'If we found data there
        If boolDataFound Then
        
            'Insert a new row below the current row
            wsData.Rows(i + 1).Insert shift:=xlShiftDown
            
            'Copy the data
            Set rngCopy = wsData.Range(wsData.Cells(i, 38), wsData.Cells(i, 42))
            rngCopy.Copy
            
            'Copy that data into cells AB-AF
            wsData.Cells(i + 1, 28).PasteSpecial xlPasteAll
            
            'Copy the value in column B
            wsData.Cells(i + 1, 2).Value = wdata.Cells(i, 2).Value
            
        End If
        
        'Now, repeat the exact same thing, but for the range AG-AK
        boolDataFound = False
        For j = 33 To 37
            
            'If it's not blank...
            If Not wsData.Cells(i, j).Text = "" Then
                
                '...then there is data.  Change the boolean to TRUE and exit the for loop
                boolDataFound = True
                Exit For
            End If
        Next j
        
        'If we found data there
        If boolDataFound Then
        
            'Insert a new row below the current row
            wsData.Rows(i + 1).Insert shift:=xlShiftDown
            
            'Copy the data
            Set rngCopy = wsData.Range(wsData.Cells(i, 33), wsData.Cells(i, 37))
            rngCopy.Copy
            
            'Copy that data into cells AB-AF
            wsData.Cells(i + 1, 28).PasteSpecial xlPasteAll
            
            'Copy the value in column B
            wsData.Cells(i + 1, 2).Value = wdata.Cells(i, 2).Value
            
        End If

    Next i
    
    'Remove the copy mode
    Application.CutCopyMode = False
    
End Sub

 

[princesscc]

Hi,

this code is great but how do i get the other rows with "client name" to move into the new rows too.

For example:

mike smith
mike smith
mike smith
matt smith
matt smith
sara smith
sara smith
sara smith
sara smith

Mike smith has 3 rows of data and i want to move all 3 rows below his name, Matt has 2 rows and need to have 2 rows below his name, Sara has 4 rows of data and i need 4 rows of the data.

Please assist.

Public Sub ShiftData()


'Declarations
Dim wsData As Worksheet

Dim rngCopy As Range

Dim i As Long 'Loop variable
Dim j As Long 'Loop variable

Dim lngFirstDataRow As Long
Dim lngLastDataRow As Long

Dim boolDataFound As Boolean 'True or false value


'Initialization
Set wsData = ActiveSheet
lngFirstDataRow = 2 'Replace with your own value - row where the data starts
lngLastDataRow = 10760 'Replace with your own value - row where the data ends


'Loop from the bottom to top. Why? Because when we insert
'rows, it will shift stuff down.
For i = lngLastDataRow To lngFirstDataRow Step -1

'Check columns u - t for data
boolDataFound = False
For j = 21 To 26 'AL is the 38th column, AP the 42nd

'If it's not blank...
If Not wsData.Cells(i, j).Text = "" Then

'...then there is data. Change the boolean to TRUE and exit the for loop
boolDataFound = True
Exit For
End If
Next j

'If we found data there
If boolDataFound Then

'Insert a new row below the current row
wsData.Rows(i + 1).Insert shift:=xlShiftDown

'Copy the data
Set rngCopy = wsData.Range(wsData.Cells(i, 21), wsData.Cells(i, 26))
rngCopy.Copy

'Copy that data into cells A-F
wsData.Cells(i + 1, 1).PasteSpecial xlPasteAll



End If


Next i

'Remove the copy mode
Application.CutCopyMode = False

 

[princesscc]

here's the sample of the excel file

Record Type	Client ID	manifestnbr - Order Number	shiptoattn - Consignee Name	Consignee Company	shiptoaddr1 - Consignee Address 1	shiptoaddr2 - Consignee Address 2	shiptocity - Consignee City	shiptostate - Consignee Province
O	9807159	29783	Mike smith		5 london street		Toronto	ON
P	9807159	29783	2	0.1	L
O	9807163	29783	Matt smith		3 paul street	PO Box 686	Belle River	ON
P	9807163	29783	2	0.2	L
O	9807164	29783	Matt smith		3 paul street	PO Box 686	Belle River	ON
P	9807164	29783	2	0.2	L
O	9807165	29783	sara smith		60 lexington street		Toronto	ON
P	9807165	29783	2	0.3	L
O	9807166	29783	sara smith		60 lexington street		Toronto	ON
P	9807166	29783	2	0.2	L
O	9807167	29783	sara smith		60 lexington street		Toronto	ON
P	9807167	29783	2	0.1	L
O	9807168	29783	sara smith		60 lexington street		Toronto	ON

<colgroup><col span="3"><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>