Excel - A macro to re-arrange cells

March 2017


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


Published by aakai1056.
This document, titled "Excel - A macro to re-arrange cells," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).