rearranging columns by reversing in location and create headers

A

abdo meghari

Well-known Member
Joined
Aug 3, 2021
Messages
651
Office Version
  1. 2019
Hi guys,
I have untidy data in columns I:N .I would arranging again in columns A:E
column A=column N
column B=column L
column C=column K
column D=column J
column E=column I
and every number is merged in column N,K,J,I then should cancel merging as show in column A,C,D,E and at the same time should merge the cells are consecutive in column L as show in column B for the number is merged in column N
after that should delete all of columns from I:N
and should create headers in row1.


before
COL.xlsm
IJKLMN
1
22,700.00JAPANBRIDGESTONEBS 1200R20 18PR G580 1
3JAP
42,680.00JAPANBRIDGESTONEBS 1200R20 18PR R187 2
5JAP
62,550.00JAPANBRIDGESTONEBS 1200R24 G5803
72,600.00JAPANBRIDGESTONEBS 1200R24 G582 JAP4
84,160.00JAPANBRIDGESTONEBS 1400R20 TCF R180 5
9JAP
104,280.00JAPANBRIDGESTONEBS 1400R20VSJ TCF JAP6
11420THILANDBRIDGESTONEBS 175/65R14 EP1507
12180TURKEYBRIDGESTONEBS 175/70R13 EP150 82S 8
13TURK
14280THILANDBRIDGESTONEBS 175/70R13 EP150 THI9
15215THILANDBRIDGESTONEBS 175/70R14 MY02 THI10
16260IndonesiaBRIDGESTONEBS 185/65R14 EP150 11
17IND
18315JAPANBRIDGESTONEBS 185/65R15 B250 JAP12
19290IndonesiaBRIDGESTONEBS 185/70R13 EP150 13
20IND
21360THILANDBRIDGESTONEBS 185/70R14 B250 THI14
22435TURKEYBRIDGESTONEBS 185R14C R660 15
23102R100R 8 TURK
24288THILANDBRIDGESTONEBS 195/60R15 EP150 THI16
25267JAPANBRIDGESTONEBS 195/60R15 T001 JAP17
26335JAPANBRIDGESTONEBS 195/65R15 EP150 JAP18
27740JAPANBRIDGESTONEBS 195/70R15C R623 19
28JAP
29490THILANDBRIDGESTONEBS 195R14C R623 THI20
30488TURKEYBRIDGESTONEBS 195R14C R660 TURK21
31428JAPANBRIDGESTONEBS 195R15C 613V JAP22
32490THILANDBRIDGESTONEBS 195R15C R623 THI23
33490TURKEYBRIDGESTONEBS 195R15C R660 TURK24
34409TURKEYBRIDGESTONEBS 205/65R15 EP150 25
35TURK
36300THILANDBRIDGESTONEBS 205/65R15 T005 THI26
SS



result should be

COL.xlsm
ABCDEFGHIJKLMN
1ITEMBRANDMARKSORIGINPRICE
21BS 1200R20 18PR G580 JAPBRIDGESTONEJAPAN2,700.00
32BS 1200R20 18PR R187 JAPBRIDGESTONEJAPAN2,680.00
43BS 1200R24 G580BRIDGESTONEJAPAN2,550.00
54BS 1200R24 G582 JAPBRIDGESTONEJAPAN2,600.00
65BS 1400R20 TCF R180 JAPBRIDGESTONEJAPAN4,160.00
76BS 1400R20VSJ TCF JAPBRIDGESTONEJAPAN4,280.00
87BS 175/65R14 EP150BRIDGESTONETHILAND420.00
98BS 175/70R13 EP150 82S TURKBRIDGESTONETURKEY180.00
109BS 175/70R13 EP150 THIBRIDGESTONETHILAND280.00
1110BS 175/70R14 MY02 THIBRIDGESTONETHILAND215.00
1211BS 185/65R14 EP150 INDBRIDGESTONEIndonesia260.00
1312BS 185/65R15 B250 JAPBRIDGESTONEJAPAN315.00
1413BS 185/70R13 EP150 INDBRIDGESTONEIndonesia290.00
1514BS 185/70R14 B250 THIBRIDGESTONETHILAND360.00
1615BS 185R14C R660 102R100R 8 TURKBRIDGESTONETURKEY435.00
1716BS 195/60R15 EP150 THIBRIDGESTONETHILAND288.00
1817BS 195/60R15 T001 JAPBRIDGESTONEJAPAN267.00
1918BS 195/65R15 EP150 JAPBRIDGESTONEJAPAN335.00
2019BS 195/70R15C R623 JAPBRIDGESTONEJAPAN740.00
2120BS 195R14C R623 THIBRIDGESTONETHILAND490.00
2221BS 195R14C R660 TURKBRIDGESTONETURKEY488.00
2322BS 195R15C 613V JAPBRIDGESTONEJAPAN428.00
2423BS 195R15C R623 THIBRIDGESTONETHILAND490.00
2524BS 195R15C R660 TURKBRIDGESTONETURKEY490.00
2625BS 205/65R15 EP150 TURKBRIDGESTONETURKEY409.00
2726BS 205/65R15 T005 THIBRIDGESTONETHILAND300.00
SS
 
Sort by date Sort by votes
@Joe4
Thanks for picking up on that. It was a copy/paste error on my part.
@abdo meghari
Those lines of code simply check to see if cell I2 contains any data. If I2 is blank, the macro will exit. It will not affect number formatting.
 
Upvote 0

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
VBA Code: 
Sub RearrangeColumns()
    If Range("I2") <> "" Then
        Application.ScreenUpdating = False
        Dim lRow As Long, x As Long
        lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Range("A1").Resize(, 5) = Array("ITEM", "BRAND", "MARKS", "ORIGIN", "PRICE")
        Range("A1").Resize(, 5).Interior.ColorIndex = Range("I1").Interior.ColorIndex
        ActiveSheet.Range("I2", Range("I" & Rows.Count).End(xlUp)).Resize(, 6).UnMerge
        For x = lRow To 2 Step -1
            If Range("K" & x) = "" Then
                Range("L" & x - 1) = Range("L" & x - 1) & " " & Range("L" & x)
                Rows(x).Delete
            End If
        Next x
        lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        With Range("A2").Resize(lRow - 1)
            .Value = Range("N2").Resize(lRow - 1).Value
            .Interior.ColorIndex = 1
            .Font.Color = vbWhite
        End With
        Range("B2").Resize(lRow - 1).Value = Range("L2").Resize(lRow - 1).Value
        Range("C2").Resize(lRow - 1).Value = Range("K2").Resize(lRow - 1).Value
        Range("D2").Resize(lRow - 1).Value = Range("J2").Resize(lRow - 1).Value
        Range("E2").Resize(lRow - 1).Value = Range("I2").Resize(lRow - 1).Value
        Range("I1").Resize(, 7).EntireColumn.Delete
        With Range("A1").Resize(lRow, 5)
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .Font.Name = "Times"
            .Font.Size = 12
        End With
        Columns.AutoFit
        Application.ScreenUpdating = True
    End If
End Sub
 
Upvote 0
What is the number format for each column in your data in columns I to N?
 
Upvote 0
Try:
VBA Code: 
Sub RearrangeColumns()
    If Range("I2") <> "" Then
        Application.ScreenUpdating = False
        Dim lRow As Long, x As Long
        lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Range("A1").Resize(, 5) = Array("ITEM", "BRAND", "MARKS", "ORIGIN", "PRICE")
        Range("A1").Resize(, 5).Interior.ColorIndex = Range("I1").Interior.ColorIndex
        ActiveSheet.Range("I2", Range("I" & Rows.Count).End(xlUp)).Resize(, 6).UnMerge
        For x = lRow To 2 Step -1
            If Range("K" & x) = "" Then
                Range("L" & x - 1) = Range("L" & x - 1) & " " & Range("L" & x)
                Rows(x).Delete
            End If
        Next x
        lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        With Range("A2").Resize(lRow - 1)
            .Value = Range("N2").Resize(lRow - 1).Value
            .Interior.ColorIndex = 1
            .Font.Color = vbWhite
        End With
        Range("B2").Resize(lRow - 1).Value = Range("L2").Resize(lRow - 1).Value
        Range("C2").Resize(lRow - 1).Value = Range("K2").Resize(lRow - 1).Value
        Range("D2").Resize(lRow - 1).Value = Range("J2").Resize(lRow - 1).Value
        With Range("E2").Resize(lRow - 1)
            .Value = Range("I2").Resize(lRow - 1).Value
            .NumberFormat = "#,##0.00"
        End With
        Range("I1").Resize(, 7).EntireColumn.Delete
        With Range("A1").Resize(lRow, 5)
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .Font.Name = "Times"
            .Font.Size = 12
        End With
        Columns.AutoFit
        Application.ScreenUpdating = True
    End If
End Sub
 
Upvote 0
If you are using my code then add the code in blue at the beginning after the line Set sht = ActiveSheet.

Rich (BB code): 
    Set sht = ActiveSheet                               ' <--- Ideally replace this with Worksheets("NameOfSheet")
    
    ' Test for no Data at I2
    If sht.Range("I2") = "" Then
        MsgBox "No Data"
        GoTo CleanExit
    End If

    With sht
        rowLastSrc = .Cells(Rows.Count, "L").End(xlUp).Row

AND this code in blue right at the end before the Application.ScreenUpdating line

Rich (BB code): 
CleanExit:
    Application.ScreenUpdating = True
 
Upvote 0
it's perfect ,Mumps.:)
many thanks buddy .
If you are using my code
Click to expand...
of course especially I see your codes in this forum is really fast despite of your codes contain many lines Unlike other members writing a few lines but not fast like you .
for me that's mystery to be fast with much writing of lines .
thank you so much ,Alex .;)
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
merge XLSX files for same sheet name based on specific files names
3 4 5
Replies
40
Views
637
abdo meghari
A
A
  • Solved
replace item for range with item for Table based on column
2
Replies
13
Views
920
Legacy 143009
L
A
  • Solved
add specific character in the beginning of item into column
Replies
9
Views
628
Fluff
Fluff
A
  • Question Question
delete unmatched item for two sheets with another two sheets and put the similar to adjacent
Replies
1
Views
419
abdo meghari
A
A
  • Question Question
Highlight and delete duplicates items in the different spaces for multiple columns
Replies
1
Views
441
abdo meghari
A

Forum statistics

Threads
1,224,828
Messages
6,181,209
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top