Can anyone help on tweeting a macro

tweacle

Rules violation
Joined
Nov 8, 2005
Messages
382
Hi there

I have the following macro

ActiveSheet.Unprotect
Rows("8:337").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B8:B61") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A8:F61")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Save
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

What im trying to do is to unprotect sheet by automatically putting in password for me sorting by column "B" and then where there a change in column "B" I need a line to seperate. I.E if in column B its all "A" and then moves onto "B" I need a free row between A & B so they are in blocks. I need to then save and reprotect worksheet inputting password automatically.

Can anyone help.

Thanks
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Try this, Untested, so try it on a copy
Code:
Sub tester()
Dim lr As Long, r As Long
ActiveSheet.Unprotect "Password" 'change to suit
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B8:B61") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A8:F61")
        .Header = xlGuess
        .Apply
    End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("A" & r).Value <> Range("A" & r - 1).Value Then
        Rows(r).Insert
    End If
Next r
ActiveWorkbook.Save
ActiveSheet.Protect "Password" 'change to suit
End Sub
 
Upvote 0
Nearly there.

It sorts them into alphabetical order but leaves a blank line between every one. What I need is to have all the ones marked "A" in a block row after row and then a blank line and "B" row after row onwards etc.
 
Upvote 0
Needs maybe a small change, just to test the first character before inserting row
If left(range("a" & r).value,1) <> left( ....
 
Upvote 0
Have I copied this correct cos it just coming up with a compile error.

Sub tester()
Dim lr As Long, r As Long
ActiveSheet.Unprotect "Password" 'change to suit
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B8:B61") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A8:F61")
.Header = xlGuess
.Apply
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If left(range("a" & r).value,1) <> left(A" & r - 1).Value Then
Rows(r).Insert
End If
Next r
ActiveWorkbook.Save
ActiveSheet.Protect "Password" 'change to suit
End Sub
 
Upvote 0
You need the same on right hand side of <> you are missing ,1) before the then
 
Upvote 0
This line needs to be
Rich (BB code):
If left(range("a" & r).value,1) <> left(A" & r - 1).Value Then

TO

If left(range("a" & r).value,1) <>left(A" & r - 1).value,1) Then
 
Upvote 0
Sorry, I can't test at the moment
try
Code:
Sub tester2()
Dim lr As Long, r As Long
ActiveSheet.Unprotect "Password" 'change to suit
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B8:B61") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A8:F61")
.Header = xlGuess
.Apply
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Left((Range("a" & r).Value), 1) <> Left((Range("a" & r - 1).Value), 1) Then
Rows(r).Insert
End If
Next r
ActiveWorkbook.Save
ActiveSheet.Protect "Password" 'change to suit
End Sub
 
Upvote 0
Tried that and its sorting the lines but still putting a gap in between every line I.E Row 1=A / ROW 2= BLANK / ROW 3=A/ ROW 4 BLANK/ ROW 5 = B

What I need is rows 1&2 = A / row 3 blank (this becuase where letter changes)/ Row 4 = B and so on.
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,236
Members
448,555
Latest member
RobertJones1986

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