Sorting by two columns across all tabs- VBA

frustrated_macro

New Member
Joined
Sep 4, 2019
Messages
49
Office Version
  1. 365
Platform
  1. Windows
I have 31 tabs in this report and i need to sort the same 2 columns across all 31 tabs
i have tried a few things and it either sorts nothing, or gives me an error

With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=ActiveSheet.Range("I1"), Order:=xlAscending
.SortFields.Add Key:=ActiveSheet.Range("G1"), Order:=xlAscending
.SetRange ActiveSheet.Range("A1:O" & LastRow)
.Header = xlYes
.Apply
End With


right above this, i have this bit of code:

Dim s As Worksheet
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For Each s In ActiveWorkbook.Sheets
Application.Goto s.Range("A2")
ActiveWindow.FreezePanes = True

Next s

i tried adding the With into its own For loop and it only did the sort on whatever page it was on and did not loop through the rest

For Each s In ActiveWorkbook.Sheets
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=ActiveSheet.Range("I1"), Order:=xlAscending
.SortFields.Add Key:=ActiveSheet.Range("G1"), Order:=xlAscending
.SetRange ActiveSheet.Range("A1:O" & LastRow)
.Header = xlYes
.Apply
End With
Next s

help :(
 
Last edited:
with this line i was just trying to skip over the first two tabs
For ws = 3 To WSCount

i had tried an If statement that was something like

For Each s In ActiveWorkbook.Sheets
If ws.Name <> "Duplo" And ws.Name <> "GU" Then
code
end if
Next s

and it kept giving me an error so i ending up changing it to the count thing
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
oh!!! i see why it didnt work!!
duh duh duh!! i think i had seen the ActiveWorkbook up top and didnt realize the rest said ActiveSheet!!!
I just fixed that, and did the if statemetn and it worked!!
Thank you so much for you help!
there were the final two codes:

For Each s In ActiveWorkbook.Sheets
LastRow = Range("A" & Rows.Count).End(xlUp).Row
With s.Sort
.SortFields.Clear
.SortFields.Add Key:=s.Range("I1"), Order:=xlAscending
.SortFields.Add Key:=s.Range("G1"), Order:=xlAscending
.SetRange s.Range("A1:Q" & LastRow)
.Header = xlYes
.Apply
End With
Next s



Dim s As Worksheet
Dim LR As Long

For Each s In ActiveWorkbook.Sheets
Application.Goto s.Range("A5")
ActiveWindow.FreezePanes = True
Next s

For Each s In ActiveWorkbook.Sheets
LR = Range("A" & Rows.Count).End(xlUp).Row
If s.Name <> "Duplo" And s.Name <> "GU" Then
On Error Resume Next
s.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

With s.Sort
.SortFields.Clear
.SortFields.Add Key:=s.Range("C4"), Order:=xlAscending
.SortFields.Add Key:=s.Range("B4"), Order:=xlAscending
.SetRange s.Range("A4:Q" & LR)
.Header = xlYes
.Apply
End With

Range("A4:Q" & LR).RemoveDuplicates Columns:=Array(6), Header:=xlYes

End If
 
Upvote 0
i PROMISE im not stupid.
tried to use the same For loop logic in a different part of the macro, where i set up the 31 tabs. so i create the tabs, rename them and then in A1 i set the reference word, for it to them use the filter formula from the source sheet to filter for X.
Then i had it going sheet by sheet and formatting columns, grabbing everything and pasting as values, and then if there was things in the sheet, it would remove dups and format it all pretty. okay, great
Tried to put it in the for loop and it loops, sure. but it gets stuck at the first tab and does nothing.
i checked for any ActiveSheet or any Sheet names and it doesnt work.
When i try to mess with the Range for the copy and paste, it then gives me a range error
so there are like 30 of these:

Sheets.Add.Name = "MAX"
Sheets("MAX").Select
Range("A1").Value = "MAX"

In row A, A1 is the only cell with any text in it

and then the big boy:

VBA Code:
Dim s As Worksheet
Dim LastRow As Long
For Each s In ActiveWorkbook.Sheets
    If s.Name <> "SOURCE DATA" And s.Name <> "Glossary" Then
     LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("A2").Formula2 = "=FILTER('SOURCE DATA'!A2:Q50000,ISNUMBER(SEARCH(A1,'SOURCE DATA'!A2:A50000)))"
    Columns(3).NumberFormat = "mm/dd/yyyy"
    Columns(13).NumberFormat = "mm/dd/yyyy"
    Columns(16).NumberFormat = "mm/dd/yyyy"
    Range("A2:Q" & LastRow).Select
    Range("A2:Q" & LastRow).Copy
    Range("A2:Q" & LastRow).PasteSpecial Paste:=xlPasteValues
    
        If s.Cells(1).CurrentRegion.Columns.Count > 1 Then
            Range("A1").EntireRow.Delete
            s.UsedRange.RemoveDuplicates Columns:=8, Header:=xlYes
            Rows("1:1").Select
            Range("A1").EntireColumn.Delete
            Range("A1:Q1").Font.Color = RGB(255, 255, 255)
            Range("A1:Q1").Interior.Color = RGB(0, 32, 96)
            Range("G1").EntireColumn.Delete
            s.Columns(15).ClearContents
            s.Columns(16).ClearContents
            Range("O1").Value = "Status"
        End If
    End If
Next s

this is what it used to be, times 31, changing each of the sheet names.


VBA Code:
Sheets.Add.Name = "MAX"
Sheets("MAX").Select
Range("A1").Value = "MAX"
Range("A2").Formula2 = "=FILTER('SOURCE DATA'!A2:Q50000,ISNUMBER(SEARCH(A1,'SOURCE DATA'!A2:A50000)))"
ActiveSheet.Columns(3).NumberFormat = "mm/dd/yyyy"
ActiveSheet.Columns(13).NumberFormat = "mm/dd/yyyy"
ActiveSheet.Columns(16).NumberFormat = "mm/dd/yyyy"
Sheets("MAX").Cells.Copy
Sheets("MAX").Cells.PasteSpecial Paste:=xlPasteValues
If ActiveSheet.Cells(1).CurrentRegion.Columns.Count > 1 Then
ActiveSheet.UsedRange.RemoveDuplicates Columns:=8, Header:=xlYes
[COLOR=rgb(0, 0, 0)]Sheets("Source Data").Select
Range("A1").EntireRow.Copy
Sheets("MAX").Select
Range("A1").PasteSpecial[/COLOR]


Range("A1").EntireColumn.Delete
Range("G1").EntireColumn.Delete
ActiveSheet.Columns(15).ClearContents
ActiveSheet.Columns(16).ClearContents
Range("O1").Value = "Status"


End If


i would also copy the header from the source tab and replace whatever i had in A1 but i also couldnt get that to work since i was copying from the source tab into all the other tabs and without the Sheet.Name i didnt know how to get it to go back to each sheet, so i just replaced it with just the formatting of it. although, as im trying this im realizing that the actual headers are not moving over, so thats still a problem i gotta solve


Range("A1").EntireColumn.Delete
Range("G1").EntireColumn.Delete
ActiveSheet.Columns(15).ClearContents
ActiveSheet.Columns(16).ClearContents
Range("O1").Value = "Status
 
Upvote 0
While you are correct that there were no other specified references of "ActiveSheet", VBA assumes "ActiveSheet" when it's not specified in front of the range. For example:
VBA Code:
Dim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
    ws.Range("A1").Value = "Hello" ' Shows up in cell A1 in every worksheet
    Range("A2").Value = "World!"   ' Shows up in cell A2 only in the currently active worksheet
Next ws

Therefore, in your case, it becomes necessary to use "s" in front of each "Range", "Columns", "Rows", "UsedRange", or "Rows" (and many other worksheet methods) to indicate the worksheet that you intend to modify.

Because of that, this modification of your code should have each of those references explicitly referenced as using the current state of "s" in each cycle of the "For" loop. I do not know if this code will work from the get go, but the specified nature of it should be helpful at least.
VBA Code:
Dim s As Worksheet
Dim LastRow As Long

For Each s In ActiveWorkbook.Sheets
    If s.Name <> "SOURCE DATA" And s.Name <> "Glossary" Then
        LastRow = s.Range("A" & s.Rows.Count).End(xlUp).Row
        s.Range("A2").Formula2 = "=FILTER('SOURCE DATA'!A2:Q50000,ISNUMBER(SEARCH(A1,'SOURCE DATA'!A2:A50000)))"
        s.Columns(3).NumberFormat = "mm/dd/yyyy"
        s.Columns(13).NumberFormat = "mm/dd/yyyy"
        s.Columns(16).NumberFormat = "mm/dd/yyyy"
        s.Range("A2:Q" & LastRow).Select
        s.Range("A2:Q" & LastRow).Copy
        s.Range("A2:Q" & LastRow).PasteSpecial Paste:=xlPasteValues
       
        If s.Cells(1).CurrentRegion.Columns.Count > 1 Then
            s.Range("A1").EntireRow.Delete
            s.UsedRange.RemoveDuplicates Columns:=8, Header:=xlYes
            s.Rows("1:1").Select
            s.Range("A1:Q1").Font.Color = RGB(255, 255, 255)
            s.Range("A1:Q1").Interior.Color = RGB(0, 32, 96)
           
            s.Range("A1").EntireColumn.Delete
            s.Range("G1").EntireColumn.Delete
            s.Columns(15).ClearContents
            s.Columns(16).ClearContents
           
            s.Range("O1").Value = "Status"
        End If
    End If
Next s
 
Upvote 0
Solution
While you are correct that there were no other specified references of "ActiveSheet", VBA assumes "ActiveSheet" when it's not specified in front of the range. For example:
VBA Code:
Dim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
    ws.Range("A1").Value = "Hello" ' Shows up in cell A1 in every worksheet
    Range("A2").Value = "World!"   ' Shows up in cell A2 only in the currently active worksheet
Next ws

Therefore, in your case, it becomes necessary to use "s" in front of each "Range", "Columns", "Rows", "UsedRange", or "Rows" (and many other worksheet methods) to indicate the worksheet that you intend to modify.

Because of that, this modification of your code should have each of those references explicitly referenced as using the current state of "s" in each cycle of the "For" loop. I do not know if this code will work from the get go, but the specified nature of it should be helpful at least.
VBA Code:
Dim s As Worksheet
Dim LastRow As Long

For Each s In ActiveWorkbook.Sheets
    If s.Name <> "SOURCE DATA" And s.Name <> "Glossary" Then
        LastRow = s.Range("A" & s.Rows.Count).End(xlUp).Row
        s.Range("A2").Formula2 = "=FILTER('SOURCE DATA'!A2:Q50000,ISNUMBER(SEARCH(A1,'SOURCE DATA'!A2:A50000)))"
        s.Columns(3).NumberFormat = "mm/dd/yyyy"
        s.Columns(13).NumberFormat = "mm/dd/yyyy"
        s.Columns(16).NumberFormat = "mm/dd/yyyy"
        s.Range("A2:Q" & LastRow).Select
        s.Range("A2:Q" & LastRow).Copy
        s.Range("A2:Q" & LastRow).PasteSpecial Paste:=xlPasteValues
      
        If s.Cells(1).CurrentRegion.Columns.Count > 1 Then
            s.Range("A1").EntireRow.Delete
            s.UsedRange.RemoveDuplicates Columns:=8, Header:=xlYes
            s.Rows("1:1").Select
            s.Range("A1:Q1").Font.Color = RGB(255, 255, 255)
            s.Range("A1:Q1").Interior.Color = RGB(0, 32, 96)
          
            s.Range("A1").EntireColumn.Delete
            s.Range("G1").EntireColumn.Delete
            s.Columns(15).ClearContents
            s.Columns(16).ClearContents
          
            s.Range("O1").Value = "Status"
        End If
    End If
Next s
ugh thank you! that did it
i went through so many tries and i swear i had tried adding the s. but its possible i missed a couple! thank you again for all your help
 
Upvote 0

Forum statistics

Threads
1,224,813
Messages
6,181,111
Members
453,021
Latest member
Justyna P

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