Excel - A macro to re-arrange cells

December 2016


Issue


I need your help to solve the following problem.
  • I have few files containing data of more than 50,000 records. Some records columns data not according to the headings. Each file containing thousands of records which require column adjustment according to the headings. I have tried it by macro recording but its work only on the row # which recorded in the macro. So, its useless for me.
  • I need a macro which work only on row if that's row's column Q or R or S or T or U (any of them contain data, use 'or' condition) containing data either numeric or text. If this condition get true then the macro do following:


Date in column 'E' cut and paste on column 'F'   
Date in column 'J' cut and paste on column 'H'   
Date in column 'L' cut and paste on column 'J' then copy 'J' and paste it on 'G'   
Date in column 'M' cut and paste on column 'W'   
Date in column 'N' cut and paste on column 'X'   
Date in column 'O' cut and paste on column 'K'   
Date in column 'P' cut and paste on column 'L'   
Date in column 'Q' cut and paste on column 'O'   
Date in column 'R' cut and paste on column 'N'   
Date in column 'U' cut and paste on column 'P'   
  • This macro should start work from raw # 5 and ends where the records end.
  • I will be very grateful to you for this help.

Solution


Try this code:
Sub test()  
Dim lRow As Integer  
'Change Q to column letter with data in the last row.  
lRow = Range("Q" & Rows.Count).End(xlUp).Row  

For Each cell In Range("Q5:Q" & lRow)  
If cell.Value <> "" _  
Or cell.Offset(0, 1).Value <> "" _  
Or cell.Offset(0, 2).Value <> "" _  
Or cell.Offset(0, 3).Value <> "" _  
Or cell.Offset(0, 4).Value <> "" Then  

cell.Offset(0, -12).Cut Destination:=cell.Offset(0, -11)  
cell.Offset(0, -7).Cut Destination:=cell.Offset(0, -9)  
cell.Offset(0, -5).Cut Destination:=cell.Offset(0, -7)  
cell.Offset(0, -7).Copy Destination:=cell.Offset(0, -10)  
cell.Offset(0, -4).Cut Destination:=cell.Offset(0, 6)  
cell.Offset(0, -3).Cut Destination:=cell.Offset(0, 7)  
cell.Offset(0, -2).Cut Destination:=cell.Offset(0, -6)  
cell.Offset(0, -1).Cut Destination:=cell.Offset(0, -5)  
cell.Copy Destination:=cell.Offset(0, -2)  
cell.Offset(0, 1).Cut Destination:=cell.Offset(0, -3)  
cell.Offset(0, 4).Cut Destination:=cell.Offset(0, -1)  
cell.ClearContents  

End If  
Next  
End Sub  


Thanks to TrowaD for this tip.

Related :

This document entitled « Excel - A macro to re-arrange cells » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.