Solved: Insert one blank row after sort 3 columns

[myzulu]

Respected Sir,
Please help me for this big problem. I just want to add blank row after sort three columns matter sort by ascending order d.name, d.add, case. Amt.

[stanleydgrom]

myzulu,

Welcome to the VBA Express forum.

Detach/open workbook myzulu - VA34088 - SDG10.xls and run macro SortInsertRow.

Having a problem attaching the workbook.



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).
Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


[vba]
Option Explicit
Sub SortInsertRow()
' stanleydgrom, 09/18/2010, VE34088
Dim w1 As Worksheet, LR As Long, a As Long
Application.ScreenUpdating = False
Application.Volatile
Set w1 = Worksheets("Sheet1")
LR = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
w1.Range("A1:G" & LR).Sort Key1:=w1.Range("D2"), Order1:=xlAscending, Key2:=w1.Range("E2") _
, Order2:=xlAscending, Key3:=w1.Range("F2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
For a = LR To 2 Step -1
If w1.Cells(a, 4) = w1.Cells(a - 1, 4) And w1.Cells(a, 5) = w1.Cells(a - 1, 5) Then
'Do nothing
Else
w1.Rows(a).Insert
End If
Next a
Application.ScreenUpdating = True
End Sub

[/vba]

Then run the "SortInsertRow" macro.

[myzulu]

You are really grt. Thanks a lot for the above macro. Can you change the "Sheet1" variable because in my excel workbook have 11 sheets and they have different name. Before 'RUN' your macro each and every time I change the sheet name & do as you say "Sheet1". And one another problem want to share with you. All the sheets have lots of rows, some of them are blank. And I want to put serial 1..n leave the blank and again start with 1..n number automatically through macro. If possible for you please help me.
Thanking you,
Yours truly
Sudip Sur (INDIA)

[stanleydgrom]

myzulu,


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.



[VBA]

Option Explicit
Sub SortInsertRow()
' stanleydgrom, 01/19/2011, VE34088
Dim w1 As Worksheet, LR As Long, a As Long
Application.ScreenUpdating = False
Application.Volatile
Set w1 = ActiveSheet
LR = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
w1.Range("A1:G" & LR).Sort Key1:=w1.Range("D2"), Order1:=xlAscending, Key2:=w1.Range("E2") _
, Order2:=xlAscending, Key3:=w1.Range("F2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
For a = LR To 2 Step -1
If w1.Cells(a, 4) = w1.Cells(a - 1, 4) And w1.Cells(a, 5) = w1.Cells(a - 1, 5) Then
'Do nothing
Else
w1.Rows(a).Insert
End If
Next a
Application.ScreenUpdating = True
End Sub

[/VBA]


Then run the SortInsertRow macro on any active worksheet.

I want to put serial 1..n leave the blank and again start with 1..n number automatically through macro.

Please attach another workbook, with the raw data on worksheet Sheet1, and what the results should look like on worksheet Results.


Have a great day,
Stan

[stanleydgrom]

myzulu,

A slight update to the new macro.

If the active worksheet cell A1 does not contain the text "sl. No.", then the macro will terminate.



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

 
Option Explicit
Sub SortInsertRow()
' stanleydgrom, 01/19/2011, VE34088
Dim w1 As Worksheet, LR As Long, a As Long
If ActiveSheet.Range("A1") <> "sl. No." Then
  MsgBox "This worksheet cell A1 does not contain 'sl. No.' - macro terminated!"
  Exit Sub
End If
Application.ScreenUpdating = False
Application.Volatile
Set w1 = ActiveSheet
LR = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
w1.Range("A1:G" & LR).Sort Key1:=w1.Range("D2"), Order1:=xlAscending, Key2:=w1.Range("E2") _
  , Order2:=xlAscending, Key3:=w1.Range("F2"), Order3:=xlAscending, Header:= _
  xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
For a = LR To 2 Step -1
  If w1.Cells(a, 4) = w1.Cells(a - 1, 4) And w1.Cells(a, 5) = w1.Cells(a - 1, 5) Then
    'Do nothing
  Else
    w1.Rows(a).Insert
  End If
Next a
Application.ScreenUpdating = True
End Sub

Then run the SortInsertRow macro on any active worksheet.

I want to put serial 1..n leave the blank and again start with 1..n number automatically through macro.

Please attach another workbook, with the raw data on worksheet Sheet1, and what the results should look like on worksheet Results.


Have a great day,
Stan

[myzulu]

Respected Stan,
Your 2nd prg(Macro) is perfectly run but the last one has some error or something else I think. May be I'm wrong. Because when I run it no serial number put on the cell(Column A). Can you please check the last one.
Thanking you,

Sudip Sur
INDIA

[stanleydgrom]

myzulu,

The latest macro runs on copies of the raw data in your original attached workbook, Sheet1 range A1:G7.

Please attach a workbook, with multiple sheets, where the latest macro does not work correctly.


Have a great day,
Stan

[myzulu]

how to upload or attach a excel file into this site?

[stanleydgrom]

myzulu,

how to upload or attach a excel file into this site?

You already did this on your first post.


To attach another workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.


Have a great day,
Stan

[myzulu]

Respected Stan,
I'm sending you the excel file for checking the problem along with my steps are written into the file. Please do the needful.
With Regards
Sudip Sur
India.

[myzulu]

Respected Stan,
I'm sending you the excel file for checking the problem along with my steps are written into the file. Pleeeeeeeeeeeeeease do the needful.
With Regards
Sudip Sur
India.

[stanleydgrom]

myzulu,

I do not understand the logic going from sheet Actual Sheet1 Sort & Insert to sheet Actual Sheet2?????


Have a great day,
Stan

[myzulu]

Respected Stan,
I just want to show you "my steps are". Before run your macro I copy the Actual Sheet1 and rename new one(Sort & Insert). After that I run your macro and erase the previous serial number. Then manually type the serial number(s) in all the cells of column A leaving each blank row. Now I think you understand.
Thanking you,

with regards
Sudip Sur

[myzulu]

Respected Stan,
R u there? If possible for you please solve my problem!
With regards
Sudip.

[shrivallabha]

Hi Sudeep,
Add below code in the same module and call it from above Sub.
[vba]Sub UpdateSerial()
Dim LR As Long, TR As Long
Dim Counter As Integer, i As Integer, j As Integer
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LR Step 1
If Range("A" & i).Value = "" Then
'Do nothing
Else
If Range("A" & i + 1).Value <> "" Then
Counter = 1
TR = Range("A" & i).End(xlDown).Row - i + 1
For j = 1 To TR
Range("A" & i).Value = Counter
Counter = Counter + 1
i = i + 1
Next j
Else
Range("A" & i).Value = 1
End If
End If
Next i
End Sub[/vba]

[myzulu]

Dear Shrivallabha,
I can't understand this "Use Internet Explorer to "SEE" the "SOLVED" button!". I am not able to add your code into the previous macro code. Please explain how to add your code into this macro.
---------------------
Option Explicit
Sub SortInsertRow()
' stanleydgrom, 01/19/2011, VE34088
Dim w1 As Worksheet, LR As Long, a As Long
If ActiveSheet.Range("A1") <> "sl. No." Then
MsgBox "This worksheet cell A1 does not contain 'sl. No.' - macro terminated!"
Exit Sub
End If
Application.ScreenUpdating = False
Application.Volatile
Set w1 = ActiveSheet
LR = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
w1.Range("A1:G" & LR).Sort Key1:=w1.Range("D2"), Order1:=xlAscending, Key2:=w1.Range("E2") _
, Order2:=xlAscending, Key3:=w1.Range("F2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
For a = LR To 2 Step -1
If w1.Cells(a, 4) = w1.Cells(a - 1, 4) And w1.Cells(a, 5) = w1.Cells(a - 1, 5) Then
'Do nothing
Else
w1.Rows(a).Insert
End If
Next a
Application.ScreenUpdating = True
End Sub
-----------
Kindly do the needful and oblige.
Thanking you,
Sudip

[shrivallabha]

Dear Shrivallabha,
I can't understand this "Use Internet Explorer to "SEE" the "SOLVED" button!". I am not able to add your code into the previous macro code.

If you want to mark your thread as solved (after getting solution that is), then this button is used which is under thread tools. But if you are using some other browser (Google's Chrome etc.) you may not be able to see it. Its a lesson learned so I've kept it in my signature!

Coming to your question. You can use the code as below:
[vba]Option Explicit
Sub SortInsertRow()
' stanleydgrom, 01/19/2011, VE34088
Dim w1 As Worksheet, LR As Long, a As Long
If UCase(ActiveSheet.Range("A1").Value) <> "SL. NO." Then 'Will run irrespective of case
MsgBox "This worksheet cell A1 does not contain 'sl. No.' - macro terminated!"
Exit Sub
End If
Application.ScreenUpdating = False
Application.Volatile
Set w1 = ActiveSheet
LR = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
w1.Range("A1:G" & LR).Sort Key1:=w1.Range("D2"), Order1:=xlAscending, Key2:=w1.Range("E2") _
, Order2:=xlAscending, Key3:=w1.Range("F2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
For a = LR To 2 Step -1
If w1.Cells(a, 4) = w1.Cells(a - 1, 4) And w1.Cells(a, 5) = w1.Cells(a - 1, 5) Then
'Do nothing
Else
w1.Rows(a).Insert
End If
Next a
UpdateSerial 'Here it calls the serial update code
Application.ScreenUpdating = True
End Sub
Sub UpdateSerial()
Dim LR As Long, TR As Long
Dim Counter As Integer, i As Integer, j As Integer
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LR Step 1
If Range("A" & i).Value = "" Then
'Do nothing
Else
If Range("A" & i + 1).Value <> "" Then
Counter = 1
TR = Range("A" & i).End(xlDown).Row - i + 1
For j = 1 To TR
Range("A" & i).Value = Counter
Counter = Counter + 1
i = i + 1
Next j
Else
Range("A" & i).Value = 1
End If
End If
Next i
End Sub
[/vba]
Overwrite the earlier code with this one. Once you run Stan's code, this macro will be called automatically and it will isert serial numbers as you need.

Kindly do the needful and oblige.
Thanking you,
Sudip

People come on their own time and do it for free, so don't expect anyone to oblige at least!

[myzulu]

Dear Shrivallabha,
You are great. Thank you. Please give me one another solution. How to ignore/avoid (each sheet of A1 row) the header row when sorting. How to set the data range from A2 to n number of row(s).

Kindly do the needful and oblige.
Thanking you,
Sudip