VBA Sort Columns by Number in a Row on every Sheet in Workbook and Combine Data from all Sheets

[Sheila8659]

I am new to VBA and haven't been able to locate a solution to a needed issue. I have managed to write/record about 1,000 lines of working code, but have hit a wall. I need to sort data by the column numbers in row 2 (see photo below) and add all missing numbers between 1 - 27 in the same row. The current sort line of code doesn't work as needed. Any help will be greatly appreciated.

Sub Sort()

Dim ws As Worksheet
Dim wsPL As Worksheet
Dim LastCol As Long
Dim i As Long

Set wsPL = Worksheets("Price List ")

For Each ws In ThisWorkbook.Worksheets

' Skips over sheet named Price List
If ws.Name <> wsPL.Name Then
ws.Activate
ws.Rows("3:3").Delete

' Add missing numbers in a sequence from 1 to 27 in row 2

' I need to sort columns by row 2 (the numbers row).

' Range("A1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, _
' Hearder:=xlYes, Orientation:=xlSortColumns


' Combine all sheets on the Price List sheet in column number sequence order,
' and delete the numbers row, leaving the row with "Group, SKU:, and so on" as the header row.

End If

Next ws

End Sub

 

[sijpie]

    With ActiveWorkbook.Worksheets("YourSheet").Sort  '<<<<Edit sheet name
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("A1").CurrentRegion _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

 

[Sheila8659]

    With ActiveWorkbook.Worksheets("YourSheet").Sort  '<<<<Edit sheet name
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("A1").CurrentRegion _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

Thank you so much for the reply. I had given up on a response!

It still doesn't work. Also, I am having issues with inserting missing numbers. However, my original issue is much more problematic since I haven't been able to correct the issue. I can't get past this hurdle.

Since the original post, I have tweaked my code to the following, updating code to your suggestion. I know I shouldn't use select, but I don't know how to get around it.

Sub TEST_Sample_MrExcel_Board_Suggestion()

Dim ws As Worksheet
Dim rng9 As Range
Dim wsPL As Worksheet
Dim LastCol As Long
Dim i As Long
Dim lastRow As Long

Set wsPL = Worksheets("Price List ")

' Loops through each sheet in workbook
For Each ws In ThisWorkbook.Worksheets
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

Set rng9 = Range("A1:Az" & lastRow)
'Skips over sheet named Price List
If ws.Name <> wsPL.Name Then
ws.Activate
' Deletes row 2, then row 3 and inserts a blank row in Row 1
ws.Rows("2:2").Delete
ws.Rows("3:3").Delete
ws.Rows("1:1").Insert
' Cuts row 3 and pastes to row 1
Range("A3:AZ3").Cut
Cells(1, 1).Select
ws.Paste
' Deletes row 3
ws.Rows("3:3").Delete
' Range("a1:az80").Activate
Range("a1:az" & lastRow).Select

'Sorts columns left to right
'Updated to your suggestion

With ws.Sort
.SortFields.Clear
.SortFields.Add2 Key:=Range("A1").CurrentRegion _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With

End If

Next ws

End Sub


Also, am I posting the code correctly; i.e. Code Tags?
I read the short guide, but I don't understand the explanation.

Sample Data:

Group	SKU:	Description	C	WT	S	W	D	H	1	2	3	4	5	L1	L2
18	19	20	21	22	23	24	25	26
1	2	3	5	6	7	8	9	10	11	12	13	14	15	16	17	4	18	19	20	21	22	23	24	25	26
Group	SKU:	DESCRIPTION	C	WT	S	W	D	H	1	2	3	4	5	L1	L2
343 PADDY	343-07	LAF SINGLE	29.8	90	1.5	40	39	41	$340	$345	$350	$355	$360	$465	$485
344 PADDY	343-05P	POWER HEADREST LAF SINGLE	29.8	108	1.5	40	39	41	$440	$445	$450	$455	$460	$565	$585
345 PADDY	343-05P NL	POWER HEADREST LAF SINGLE SEAT	29.8	108	1.5	40	39	41	$465	$470	$475	$480	$485	$590	$610
346 PADDY	343-08	RAF SINGLE SEAT	29.8	90	1.5	40	39	41	$340	$345	$350	$355	$360	$465	$485
347 PADDY	343-06P	POWER HEADREST RAF SINGLE	29.8	108	1.5	40	39	41	$440	$445	$450	$455	$460	$565	$585
348 PADDY	343-06P NL	POWER HEADREST RAF SINGLE SEAT	29.8	108	1.5	40	39	41	$465	$470	$475	$480	$485	$590	$610

The second set of code below the sample data works well, except when inserting missing column numbers, it skips some blank columns and inserts the missing numbers based on the far-right column (AZ). I would like it not to skip those missing columns. The 4 in Row 3Column 17 above is actually in Column 26.

Sub Insert_Missing_Columns_by_Number()
'
'********************************
' INSERT MISSING COLUMN
'********************************

Dim ws As Worksheet
Dim wsPL As Worksheet

Set wsPL = Worksheets("Price List ")

' Loops through each sheet in workbook
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> wsPL.Name Then
ws.Activate
Range("A1").Activate

' Insert row in Row 1
Rows("2:2").Insert
Range("A2").Activate

' Find missing column numbers based on row 2 = FINAL HEADER NUMBER
ActiveCell.Formula2R1C1 = _
"=IFERROR(SMALL(IF(COUNTIF(R[1]C:R[1]C[25],COLUMN(C1:C26))=0,COLUMN(C1:C26),""""),COLUMN(C1:C26)),"""")"

' Copies range A1:Z1 and pastes values to row 1
ws.Range("A2").Copy

' Copies range A1:Z1 and pastes values to first black column in row 2
Range("A2:Z2").Copy
Cells(3, Columns.Count).End(xlToLeft).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If

Next ws

End Sub

 

[Sheila8659]

This is how I would like the final data to appear.

Group	SKU:	Description		C	WT	S	W	D	H	1	2	3	4	5	L1	L2
1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26
343 PADDY	343-07	LAF SINGLE		29.8	90	1.5	40	39	41	$340	$345	$350	$355	$360	$465	$485
344 PADDY	343-05P	POWER HEADREST LAF SINGLE		29.8	108	1.5	40	39	41	$440	$445	$450	$455	$460	$565	$585
345 PADDY	343-05P NL	POWER HEADREST LAF SINGLE SEAT		29.8	108	1.5	40	39	41	$465	$470	$475	$480	$485	$590	$610
346 PADDY	343-08	RAF SINGLE SEAT		29.8	90	1.5	40	39	41	$340	$345	$350	$355	$360	$465	$485
347 PADDY	343-06P	POWER HEADREST RAF SINGLE		29.8	108	1.5	40	39	41	$440	$445	$450	$455	$460	$565	$585
348 PADDY	343-06P NL	POWER HEADREST RAF SINGLE SEAT		29.8	108	1.5	40	39	41	$465	$470	$475	$480	$485	$590	$610
349 PADDY	343-92	ARMLESS		23.1	87	1.1	33	39	41	$265	$270	$275	$280	$285	$390	$410
350 PADDY	343-90P	POWER		23.1	97	1.1	33	39	41	$365	$370	$375	$380	$385	$490	$510

 

[Sheila8659]

Sorry for so many replies. This is the error I receive when I run .Apply line of code un the sort with function.

Run-time error '1004":
The sort reference is not valid. Make sure that it's within the data you want to sort, and the first Sort By box isn't the same or blank.

 

[sijpie]

When I have time I will fill out a worksheet and test the code

 

[sijpie]

Correction to the code:

Sub SortByCol()
'
' SortByCol Macro
'

'
   
    With ActiveWorkbook.Worksheets("Sheet4")   'Edit sheet name
   
        .Rows(4).EntireRow.Delete
        .Rows(2).EntireRow.Delete
        With .Sort   'Edit sheet name
            .SortFields.Clear
            .SortFields.Add2 Key:=Range("A2") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A1").CurrentRegion
'            .Header = xlYes
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub