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
 

Some videos you may like

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,766
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
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
 

tweacle

Rules violation
Joined
Nov 8, 2005
Messages
382
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.
 

jimrward

Well-known Member
Joined
Feb 24, 2003
Messages
1,784
Office Version
  1. 2016
  2. 2013
  3. 2011
  4. 2010
  5. 2007
Platform
  1. Windows
Needs maybe a small change, just to test the first character before inserting row
If left(range("a" & r).value,1) <> left( ....
 

tweacle

Rules violation
Joined
Nov 8, 2005
Messages
382

ADVERTISEMENT

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
 

jimrward

Well-known Member
Joined
Feb 24, 2003
Messages
1,784
Office Version
  1. 2016
  2. 2013
  3. 2011
  4. 2010
  5. 2007
Platform
  1. Windows
You need the same on right hand side of <> you are missing ,1) before the then
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,766
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

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
 

tweacle

Rules violation
Joined
Nov 8, 2005
Messages
382
Thanks but im coming up with a compile error. says "Expected list seperator or )"
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,766
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
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
 

tweacle

Rules violation
Joined
Nov 8, 2005
Messages
382
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,271
Messages
5,600,650
Members
414,399
Latest member
Ninjee

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
Top