Data Sort & paste another sheet

[vidhate0123]

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]FROM[/TD]
[TD]TO[/TD]
[TD]SIDE[/TD]
[TD]TYPE[/TD]
[/TR]
[TR]
[TD]0[/TD]
[TD]20[/TD]
[TD]LHS[/TD]
[TD]PQC[/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD]30[/TD]
[TD]LHS[/TD]
[TD]DLC[/TD]
[/TR]
[TR]
[TD]35[/TD]
[TD]50[/TD]
[TD]BHS[/TD]
[TD]PQC[/TD]
[/TR]
[TR]
[TD]65[/TD]
[TD]67[/TD]
[TD]RHS[/TD]
[TD]DLC[/TD]
[/TR]
[TR]
[TD]68[/TD]
[TD]70[/TD]
[TD]RHS[/TD]
[TD]PQC[/TD]
[/TR]
[TR]
[TD]71[/TD]
[TD]77[/TD]
[TD]BHS[/TD]
[TD]DLC[/TD]
[/TR]
[TR]
[TD]88[/TD]
[TD]90[/TD]
[TD]LHS[/TD]
[TD]DLC[/TD]
[/TR]
[TR]
[TD]91[/TD]
[TD]95[/TD]
[TD]RHS[/TD]
[TD]PQC[/TD]
[/TR]
[TR]
[TD]95[/TD]
[TD]98[/TD]
[TD]BHS[/TD]
[TD]PQC[/TD]
[/TR]
</tbody>[/TABLE]

In above table I want to do made VBA code as requirement below.
First sort the rows Heading "TYPE" and then sort by "SIDE". after than I want to convert "BHS"rows to 2 rows Side name LHS & RHS ,other data in row remain same.
(LHS mean left hand side,RHS means Right hand Side, BHS means Both hand Side)

 

[jim may]

Seems like you'd want to do the Convert FIRST, then the Sort. Am I right, or Wrong? Please clarify for me.

 

[vidhate0123]

Yes Sir

 

[jim may]

Try this on a BACK-UP COPY of your file FIRST !!!

Paste the 2 below Macros into a Standard Module. With and while your data table the Active sheet RUN ONLY the Macro named "FixMyTable". You will not need to run the 2nd Macro Seperately As it is being RUN WITHIN the "FixMyTable" Macro - Because it is BEING "CALLED" -- see the line near bottom where it reads

Call SortMyDb​

Good luck. Jim

Sub FixMyTable()
Dim SR As Long, i As Long
Application.ScreenUpdating = False
SR = Range("A" & Rows.Count).End(xlUp).Row + 1
For i = SR To 2 Step -1
    If Cells(i, 3).Value = "BHS" Then
        Cells(i + 1, 3).EntireRow.Insert
            Cells(i + 1, 3).Offset(-1, 0).Rows("1:1").EntireRow.Copy
            Cells(i, 1).Offset(1).Rows("1:1").PasteSpecial
                Cells(i, 3).Value = "LHS & RHS"
                Cells(i + 1, 3).Value = "LHS & RHS"
                Application.CutCopyMode = False
    End If
Next i
Range("A1").Select
Call SortMyDb
Application.ScreenUpdating = True
End Sub


Sub SortMyDb()
Columns("A:D").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Range("A1").Select
End Sub

 

[vidhate0123]

Try this on a BACK-UP COPY of your file FIRST !!!

Paste the 2 below Macros into a Standard Module. With and while your data table the Active sheet RUN ONLY the Macro named "FixMyTable". You will not need to run the 2nd Macro Seperately As it is being RUN WITHIN the "FixMyTable" Macro - Because it is BEING "CALLED" -- see the line near bottom where it reads

Call SortMyDb​

Good luck. Jim

Sub FixMyTable()
Dim SR As Long, i As Long
Application.ScreenUpdating = False
SR = Range("A" & Rows.Count).End(xlUp).Row + 1
For i = SR To 2 Step -1
    If Cells(i, 3).Value = "BHS" Then
        Cells(i + 1, 3).EntireRow.Insert
            Cells(i + 1, 3).Offset(-1, 0).Rows("1:1").EntireRow.Copy
            Cells(i, 1).Offset(1).Rows("1:1").PasteSpecial
                Cells(i, 3).Value = "LHS & RHS"
                Cells(i + 1, 3).Value = "LHS & RHS"
                Application.CutCopyMode = False
    End If
Next i
Range("A1").Select
Call SortMyDb
Application.ScreenUpdating = True
End Sub


Sub SortMyDb()
Columns("A:D").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Range("A1").Select
End Sub

Thanks For quick reply , It work perfectly. Minor rectification was in code i.e. "LHS & RHS" replaced by LHS one time & RHS next time . That I have done. Now Sorting of LHS & RHS (SIDE Heading)still balance.

 

[jim may]

Thanks For quick reply , It work perfectly. Minor rectification was in code i.e. "LHS & RHS" replaced by LHS one time & RHS next time . That I have done. Now Sorting of LHS & RHS (SIDE Heading)still balance.

After making modificatuon, is the sort performing OK?

 

[vidhate0123]

Yes Sir, it working perfectly.