I've been struggling for several hours to set row heights for an implied range. The code works except for two problems 1. ALL rows with data are set to AutoFit instead of just the intended range and 2. I cannot seem to add '3' to the row height per the 2nd to last line of code:
Sub SetRH()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("C" & (ActiveCell.row)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection.Offset(0, 0), Selection.Offset(0, 4)).Select
Selection.sort Key1:=Range("C6"), Order1:=xlAscending, Key2:=Range("E6") _
, Order2:=xlAscending, Key3:=Range("D6"), Order3:=xlAscending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Each row In ActiveSheet.UsedRange.Rows: Rows.AutoFit: Next
For Each row In ActiveSheet.UsedRange.Rows: Rows.RowHeight = Rows.RowHeight + 3: Next
Application.ScreenUpdating = True
End Sub
Any help is much appreciated!
The below code will loop through each row auto fit and then increase the row height by +3.
Dim ws As Worksheet
Set ws = ActiveSheet
Dim Rng As Range
Dim cel As Range
Set Rng = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
For Each cel In Rng
cel.Rows.AutoFit
cel.Rows.RowHeight = cel.Rows.RowHeight + 3
Next cel
Related
I export a schedule from MS Teams to Excel for data manipulation.
I made a macro that changes the dates field to a date format for the EU and sorts by it by date.
Then it goes to the next worksheet and checks the names of employees and creates a worksheet for each of the names.
Then it jumps back to the first worksheet, sorts by "name" criteria and copies the data for every single one to its own respective worksheet.
This is what I got so far that is OK:
Sub Temp1()
'Convert Cell Format from Text to Date and change MDY to DMY Format
Sheets("Shifts").Select
Range("D2:D1000").Select
Selection.TextToColumns Destination:=Range("D2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 3), TrailingMinusNumbers:=True
Range("F2:F1000").Select
Selection.TextToColumns Destination:=Range("F2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 3), TrailingMinusNumbers:=True
'Add the Sheets for each member of the "Members" Sheet
Sheets("Members").Select
Dim xRg As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Application.ScreenUpdating = False
For Each xRg In wSh.Range("A2:A22")
With wBk
.Sheets.Add After:=.Sheets(.Sheets.Count)
ActiveCell.FormulaR1C1 = "Evidencija radnog vremena"
Selection.Font.Size = 20
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "Godina i mjesec"
Selection.Font.Size = 14
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "Radnik"
Selection.Font.Bold = True
ActiveCell.Offset(2, 0).Range("A1").Select
On Error Resume Next
ActiveSheet.Name = xRg.Value
Range("B2").Value = ActiveSheet.Name
If Err.Number = 1004 Then
Debug.Print xRg.Value & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
Application.ScreenUpdating = True
'Sort by Date
Sheets("Shifts").Select
Range("A1").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes
After this I need some kind of loop or switch case or Foreach - i don't know what exactly.
I have it hardcoded for now, but it will become bulky, slow and problematic to maintain.
What I need to do:
Go through the list of employees, find for the employee all data and copy it to his respective worksheet - which has already been created.
Here is the hardcoded version of the code:
ActiveSheet.Range("$A$1:$L$276").AutoFilter Field:=1, Criteria1:= _
"Employee name"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Employee name").Select
ActiveSheet.Paste
ActiveSheet.PageSetup.Orientation = xlPortrait
Columns("A:L").AutoFit
For Each r In Range("I:I").SpecialCells(xlCellTypeConstants)
r.Interior.ColorIndex = xlNone
If r.Value Like "*Home Office*" Then r.Interior.Color = vbGreen
If r.Value Like "*Neradni dan*" Then r.Interior.Color = vbRed
If r.Value Like "*Bolovanje*" Then r.Interior.Color = vbBlue
If r.Value Like "*Godišnji odmor*" Then r.Interior.ColorIndex = 29
Next
Columns("L").EntireColumn.Delete
Columns("J").EntireColumn.Delete
Columns("H").EntireColumn.Delete
Columns("C").EntireColumn.Delete
Columns("B").EntireColumn.Delete
Columns("G").EntireColumn.Delete
I copied the whole code below.
A clarification of what it needs to do:
sort the data in the first worksheet - already handled
create the worksheets by the names in the 3rd worksheet - working
On the first sheet, that is already "sorted" - I need to go through all the names, copy the the data that is relevant to the sheet - i.e the sheets are named by names that are found in row a. so i need it to go through the first worksheet, need all the data that has the same name in the row a and copy it to the respective sheet. - PLEASE HELP :)
Sub TEMPExcelObradiTablicuZaObracunPlaca()
'Convert Cell Format from Text to Date and change MDY to DMY Format
Sheets("Shifts").Select
Range("D2:D1000").Select
Selection.TextToColumns Destination:=Range("D2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 3), TrailingMinusNumbers:=True
Range("F2:F1000").Select
Selection.TextToColumns Destination:=Range("F2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 3), TrailingMinusNumbers:=True
'Ovdje dodajem potrebne Sheetove iz Members Sheeta
Sheets("Members").Select
Dim xRg As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Application.ScreenUpdating = False
For Each xRg In wSh.Range("A2:A22")
With wBk
.Sheets.Add After:=.Sheets(.Sheets.Count)
ActiveCell.FormulaR1C1 = "Evidencija radnog vremena"
Selection.Font.Size = 20
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "Radnik"
Selection.Font.Size = 14
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "Godina i mjesec"
Selection.Font.Bold = True
ActiveCell.Offset(2, 0).Range("A1").Select
'Range("B2).Value = DateAdd(mmmm, yyyy) -> OVDJE SAM ZAPEO TU NASTAVITI!!! - dodavanje datuma u b2 celiju!
On Error Resume Next
ActiveSheet.Name = xRg.Value
Range("B2").Value = ActiveSheet.Name
If Err.Number = 1004 Then
Debug.Print xRg.Value & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
Application.ScreenUpdating = True
'Sort by Date
Sheets("Shifts").Select
Range("A1").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes
'Define LASTROW to find the last row and column in Members Sheetu!
Dim LastRow As Long, LastColumn As Long
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range("A1").Resize(LastRow, LastColumn).Select
'Proba ForEach petlje
' Creating a range of sheet names from the data on Members
Dim SheetNamesRange As Range
Set SheetNamesRange = Sheets("Members").Range("A2:A" & LastRow)
' Iterate through all sheets in the range and write the word "Updated" in cell B2
Dim SheetName As Variant, SheetNameString As String
For Each SheetName In SheetNamesRange
' OVDJE SAM ISKOMENTIRAO OVA 2 REDA
'SheetNameString = CStr(SheetName)
'ThisWorkbook.Sheets(SheetNameString).Range("Q2") = "Updated"
Sheets("Shifts").Range("$A$1:$L$276").AutoFilter Field:=1, Criteria1:="SheetNameString"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'SheetNameString = CStr(SheetName)
Sheets.CStr(SheetNameString).Select
ActiveSheet.Paste
ActiveSheet.PageSetup.Orientation = xlPortrait
Columns("A:L").AutoFit
For Each r In Range("I:I").SpecialCells(xlCellTypeConstants)
r.Interior.ColorIndex = xlNone
If r.Value Like "*Home Office*" Then r.Interior.Color = vbGreen
If r.Value Like "*Neradni dan*" Then r.Interior.Color = vbRed
If r.Value Like "*Bolovanje*" Then r.Interior.Color = vbBlue
If r.Value Like "*Godišnji odmor*" Then r.Interior.ColorIndex = 29
Next
Columns("L").EntireColumn.Delete
Columns("J").EntireColumn.Delete
Columns("H").EntireColumn.Delete
Columns("C").EntireColumn.Delete
Columns("B").EntireColumn.Delete
Columns("G").EntireColumn.Delete
Next SheetName
End Sub
You are right, a For Each loop can be used here. Here is some code that outlines the basic principle:
Private Sub Shone()
' Creating a range of sheet names from the data on Sheet1
Dim SheetNamesRange As Range
Set SheetNamesRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A3")
' Iterate through all sheets in the range and write the word "Updated" in cell B2
Dim SheetName As Variant, SheetNameString As String
For Each SheetName In SheetNamesRange
SheetNameString = CStr(SheetName)
ThisWorkbook.Sheets(SheetNameString).Range("B2") = "Updated"
Next SheetName
End Sub
In this example, I want to grab the names of sheets written on Sheet1, and write the word "Updated" in cell B2 on each of those sheets.
The cells A1, A2, and A3 on the sheet Sheet1 contain the following text, respectively, "Sheet1", "Sheet2", "Sheet3". First, I create a Range of data. That data is just the sheet names in cells A1:A3. It goes without saying that your Range will contain different data, but I believe that you have already taken care of that part.
Next, I iterate through that Range of data. A For Each loop requires the iterator (in this case, the variable SheetName) to be a Variant datatype. As I iterate through all of the sheets, I finally get to what I want to do: write the word "Updated" in cell B2. Finally, we reach the Next statement which tells us that the next step of the For Each loop will start, if there are any more members in the SheetNamesRange to iterate through.
I want to do lookup in a specified range(rows X to AF in "main" tab[Sheet1]) which I am doing using VBA hlookup function. The problem I am facing is that I am not able to do this lookup in a loop, which means once the hlookup is done in X2:AF2, then it should do the calculation in X3:AF3 for next row.
I need to do this because the Tablehandle[sheeet2] result will change every time (macro will clear this sheet) and the headers will not in order.
So can someone help me to get hlookup in a loop for a specified row?
My "Main" sheet
"TableHandle" sheet
Option Explicit
Sub hlookup1()
Dim i, r As Long
For i = 1 To Range("K100000").End(xlUp).Row - 1
'first macro will get the table inside sheet ...
Sheets("TableHandle").Select
'Range("A2").Select
'Range(Selection, Selection.End(xlDown)).Select
'Range("A2:B10").Select
'Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'hlookup
Sheets("Main").Select
Range("X2").Select
Range("X" & i + 1).Select
ActiveCell.FormulaR1C1 = "=HLOOKUP(R1C,TableHandle!R1C6:R2C14,2,0)"
Selection.Copy
Range("X2:AF2").Select 'PROBLEM from Here, it will again calculate in x2 to af2 range)
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
i = i + 1
Next
End Sub
Yours is a good idea but in practice it has a number of drawbacks as demonstrated by the error handling you had planned. I think you would also have to replace the formulas you insert with so much effort with the values they produce. Please try this code instead. It transfers data from the TableHandler sheet to the Main without the use of worksheet formulas.
Sub hlookup1()
' 211
Dim Data As Variant ' source data
Dim Headers As Range ' column captions in 'Main'
Dim Fnd As Range ' Find the column caption
Dim Rs As Long ' Row: Source (= 'Data')
Dim Cs As Long ' Column: Source
Dim Rt As Long ' Row: Target
Dim Ct As Long ' Column: Target
'first macro will get the table inside sheet ...
With Worksheets("TableHandle") ' data source
Rs = .Cells(.Rows.Count, "A").End(xlUp).Row
Data = .Range(.Cells(2, "A"), .Cells(Rs, "X")).Value
' Row 1 of 'Data' holds the column headers because
' SheetRow(2) became the ArrayRow(1)
End With
Application.ScreenUpdating = False ' speed up execution
With Worksheets("Main")
Set Headers = .Range("A2:X2")
' start in array row 2 because array row 1 holds the column captions
For Rs = 2 To UBound(Data) ' loop through all rows
Rt = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
For Cs = 1 To UBound(Data, 2) ' loop through the columns of each row
Set Fnd = Headers.Find(Data(1, Cs), LookIn:=xlValues, lookat:=xlWhole)
If Not Fnd Is Nothing Then ' skip column not found
.Cells(Rt, Fnd.Column).Value = Data(Rs, Cs)
End If
Next Cs
Next Rs
End With
Application.ScreenUpdating = True
End Sub
If a column in the TableHandler should not be found the macro will not transfer data, leaving the target column blank. If you want a warning it would have to be added. There is a little confusion in your question as to rows and columns. Should I have guessed wrongly here or there I trust you will be able to make the required modifications. However, you are welcome to ask for help, too.
it was important and i spent all day to make this possible, i ans my question here.
the code is shortned as below, it works fast and efficient. thanks for suggestions!
Dim Hlookp As Variant
Hlookp = Application.HLookup(Range("B1:J1").Value, Sheets("TableHandle").Range("F1:N" & Cells(Rows.Count, 1).End(xlUp).row), 2, False)
Range("B" & i + 1 & ":J" & i + 1).Value = Hlookp
I have a roster of names pulled from another sheet then auto sorted using macros.
When the formula returns no value "empty text" it is pushed to the top. How do I push it to the bottom while still returning the sorted value ascending?
Public Sub Worksheet_Activate()
Sheet6.Unprotect Password:="xxxxxxx"
Range("A1:F151").Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Sheet6.Protect Password:="xxxxxxx", _
DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sort Ascending: Blanks to the Bottom
Uncomment the Debug.Print lines to monitor the ranges at the four 'stages'.
The Code
Option Explicit
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Me.Unprotect Password:="xxxxxx"
' Define constants.
Const Cols As String = "A:F"
Const FirstRow As Long = 1
Const CriteriaColumn As Long = 1
' Define Source Range (There are many ways).
' Define Processing Range (from defined first row to bottom-most row).
With Columns(Cols).Resize(Rows.Count - FirstRow + 1).Offset(FirstRow - 1)
' Validate Criteria Column.
If .Columns.Count < CriteriaColumn Then
Exit Sub
End If
' Define Source First Cell Range ('fCell').
Dim fCell As Range
Set fCell = .Cells(1)
'Debug.Print fCell.Address
' Define Source Range ('rng').
Dim rng As Range
Set rng = Intersect(fCell.CurrentRegion, .Cells)
'Debug.Print rng.Address
End With
' Sort Source Range.
' Sort descending.
rng.Sort Key1:=fCell.Offset(, CriteriaColumn - 1), _
Order1:=xlDescending, _
Header:=xlYes
' Define Last Non-Blank Cell in Criteria Column ('lCell').
Dim lCell As Range
Set lCell = rng.Columns(CriteriaColumn).Find(What:="*", _
LookIn:=xlValues, _
SearchDirection:=xlPrevious)
'Debug.Print lCell.Address
' Define Non-Blank Range ('rng').
Set rng = rng.Resize(lCell.Row - rng.Row + 1)
'Debug.Print rng.Address
' Sort Non-Blank Range ascending.
rng.Sort Key1:=fCell.Offset(, CriteriaColumn - 1), _
Order1:=xlAscending, _
Header:=xlYes
Me.Protect Password:="xxxxxx", _
DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
I have values in this "Sample Analysis Data" sheet in the range B2:B10.
For each cell in the range, the code looks for that value in the sheet "Meta Data". It then copies the cells in that row and pastes it in "Sample Analysis Data" (to the right of the searched value). This works for the value in B2.
I can't get it to move on to B3 and then B4 and such. It loops though and does the same thing again for B2.
What do I need to do to get it to loop to from B2 through to B10?
Along with this, how do I get it to go from B2 to the last entry in the column (as each data set I work with could have a different number of rows of data,) not just to B10?
Sub GetMetaData()
Worksheets("Sample Analysis Data").Activate
Range("B2").Select
Dim srch As Range, cell As Variant
Set srch = Range("B2:B10")
For Each cell In srch
Sheets("Meta Data").Activate
Cells.Find(What:=cell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveSheet.Cells(ActiveCell.Row, 1).Select
Range(ActiveCell, ActiveCell.End(xlToRight).End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sample Analysis Data").Activate
ActiveCell.Offset(0, 7).Select
ActiveSheet.Paste
Next cell
End Sub
Try this?
Change the i=8 to however many cells you need to offset (you indicated B2:B10, which is 8)
Sub testcopy()
Dim srch As Range, metarg As Range, rg As Range, pstrg As Range
Dim i As Long
Dim ws As Worksheet, ws2 As Worksheet
Set ws = ThisWorkbook.Sheets("Sample Analysis Data")
Set ws2 = ThisWorkbook.Sheets("Meta Data")
Set metarg = ws2.Range("A1:A100") 'range that includes the key that you are searching in B2:B10
Set srch = ws.Range("B1") 'i'm offsetting, so i'm going back one row
For i = 1 To 8 'change 8 to how many cells to offset
Set rg = metarg.Find(srch.Offset(i, 0).Value, LookIn:=xlValues, lookat:=xlWhole) 'find the value in meta sheet
If Not rg Is Nothing Then
Set pstrg = ws2.Range(rg, ws2.Cells(rg.Row, rg.End(xlToRight).Column))
pstrg.Copy
srch.Offset(i, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Next i
End Sub
I've got this table full of data. And column K in each row contains a number. So basically what I'm trying to do is move that entire row, if the data in that column is greater than 9, over to sheet2.
How can this be achieved? I've already created actual tables in the sheets, called Table1 and Table2.
This is what I've managed to put together so far. I've looked at autofilter, but I can't understand squat of what's happening in there. So this I get!
Sub MoveData()
Dim i As Range
Dim num As Integer
num = 1
For Each i In Range("K10:K1000")
If i.Value > 9 Then
i.Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets("Sheet2").Range("A65000").End(xlUp).Offset(num, 0).PasteSpecial
ActiveCell.Rows.Delete
num = num + 1
End If
Next i
End Sub
This kinda works so far. But I can't manage to paste the row to the next blank row in sheet2. I tried doing that num = num + 1 thing, but I guess that's way off?
Is this what you are trying? (TRIED AND TESTED)
Option Explicit
Sub Sample()
Dim wsI As Worksheet, wsO As Worksheet
Dim rRange As Range
Dim lastRowWsO As Long
Set wsI = Sheets("sheet1")
'~~> Assuming that the Header is in K10
Set rRange = wsI.Range("K10:K1000")
Set wsO = Sheets("sheet2")
'~~> Get next empty cell in Sheet2
lastRowWsO = wsO.Range("A" & Rows.Count).End(xlUp).Row + 1
With wsI
'~~> Remove Auto Filter if any
.AutoFilterMode = False
With rRange
'~~> Set the Filter
.AutoFilter Field:=1, Criteria1:=">=9"
'~~> Temporarirly hide the unwanted rows
wsI.Rows("1:9").EntireRow.Hidden = True
wsI.Rows("1001:" & Rows.Count).EntireRow.Hidden = True
'~~> Copy the Filtered rows
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
wsO.Rows(lastRowWsO)
'~~> Delete The filtered rows
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
'~~> Unhide the rows
.Rows("1:9").EntireRow.Hidden = False
.Rows("1001:" & Rows.Count).EntireRow.Hidden = False
'~~> Remove Auto Filter
.AutoFilterMode = False
End With
End Sub
NOTE: I have not included any error handling. I would recommend you to include one in the final code
FOLLOWUP
Sub Sample()
Dim wsI As Worksheet, wsO As Worksheet
Dim rRange As Range
Dim lastRowWsI As Long, lastRowWsO As Long
Set wsI = Sheets("Risikoanalyse")
'~~> Assuming that the Header is in K10
Set rRange = wsI.Range("K9:K1000")
lastRowWsI = wsI.Cells.Find(What:="*", _
After:=wsI.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Set wsO = Sheets("SJA utarbeides")
'~~> Get next empty cell in Sheet2
lastRowWsO = wsO.Cells.Find(What:="*", _
After:=wsO.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row + 1
With wsI
With .ListObjects("TableRisikoAnalyse")
'~~> Set the Filter
.Range.AutoFilter Field:=11, Criteria1:=">=9"
'~~> Temporarirly hide the unwanted rows
wsI.Rows("1:8").EntireRow.Hidden = True
wsI.Rows(lastRowWsI & ":" & Rows.Count).EntireRow.Hidden = True
'~~> Copy the Filtered rows
wsI.Range(Replace(wsI.Range("K9").Offset(1, 0).SpecialCells(xlCellTypeVisible).Address, "$9:$9,", "")).EntireRow.Copy _
wsO.Rows(lastRowWsO)
'~~> Clear The filtered rows
wsI.Range(Replace(wsI.Range("K9").Offset(1, 0).SpecialCells(xlCellTypeVisible).Address, "$9:$9,", "")).Clear
.Range.AutoFilter Field:=11
'~~> Sort the table so that blank cells are pushed down
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("TableRisikoAnalyse[[ ]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, DataOption:=xlSortTextAsNumbers
With .Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
'~~> Unhide the rows
.Rows("1:8").EntireRow.Hidden = False
.Rows(lastRowWsI & ":" & Rows.Count).EntireRow.Hidden = False
'~~> Remove Auto Filter
.AutoFilterMode = False
End With
End Sub