Oct 27 2020 07:50 PM
Hi Everybody,
I am trying to sort this excel file.
What I am trying to do is this:
What I have tried:
I put the macros I tried into sheets called MACRO 1 and MACRO 2
Thanks in advanced
Alan
Oct 27 2020 09:48 PM
Instead of creating one macro for each type available in column C, you may try something like below. Place this macro on a Standard Module like Module1 and then if you want this macro to run when the file is opened, call this macro within Workbook_Open event on ThisWorkbook Module.
Sub CopyData()
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim shName As String
Dim lr As Long
Dim lc As Long
Dim dlr As Long
Dim Rng As Range
Dim Cel As Range
Application.ScreenUpdating = False
Set wsData = Worksheets("LR Listing")
lr = wsData.Cells(Rows.Count, "C").End(xlUp).Row
lc = wsData.UsedRange.Columns.Count
Set Rng = wsData.Range("C2:C" & lr)
For Each Cel In Rng
If Cel.Value <> "" Then
shName = Cel.Value
shName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(shName, ":", ""), "/", ""), "\", ""), "?", ""), "*", ""), "[", ""), "]", "")
On Error Resume Next
Set wsDest = Worksheets(shName)
On Error GoTo 0
If wsDest Is Nothing Then
Set wsDest = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wsDest.Name = shName
End If
dlr = wsDest.Cells(Rows.Count, "C").End(xlUp).Row + 1
wsData.Range(wsData.Cells(Cel.Row, 1), wsData.Cells(Cel.Row, lc)).Copy wsDest.Range("A" & dlr)
End If
Set wsDest = Nothing
Next Cel
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
Call CopyData
End Sub
Oct 27 2020 10:21 PM
@Subodh_Tiwari_sktneer Thanks for the quick reply.
The majority of it works, but it does not sort FuseSaver, IntelliRupter, and IntelliRupter LS.
Does the name have to match exactly?
Alan
Oct 27 2020 11:33 PM
Solution
By sorting if you mean sorting the Sheet Tabs, you may replace the existing code with the following one...
Dim wsData As Worksheet
Sub CopyData()
Dim wsDest As Worksheet
Dim shName As String
Dim lr As Long
Dim lc As Long
Dim dlr As Long
Dim Rng As Range
Dim Cel As Range
Application.ScreenUpdating = False
Set wsData = Worksheets("LR Listing")
lr = wsData.Cells(Rows.Count, "C").End(xlUp).Row
lc = wsData.UsedRange.Columns.Count
Set Rng = wsData.Range("C2:C" & lr)
For Each Cel In Rng
If Cel.Value <> "" Then
shName = Cel.Value
shName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(shName, ":", ""), "/", ""), "\", ""), "?", ""), "*", ""), "[", ""), "]", "")
On Error Resume Next
Set wsDest = Worksheets(shName)
On Error GoTo 0
If wsDest Is Nothing Then
Set wsDest = Worksheets.Add(After:=Worksheets(Worksheets.Count))
wsDest.Name = shName
End If
dlr = wsDest.Cells(Rows.Count, "C").End(xlUp).Row + 1
wsData.Range(wsData.Cells(Cel.Row, 1), wsData.Cells(Cel.Row, lc)).Copy wsDest.Range("A" & dlr)
End If
Set wsDest = Nothing
Next Cel
Call SortSheetTabs
wsData.Activate
Application.ScreenUpdating = True
End Sub
Sub SortSheetTabs()
Dim i As Integer, j As Integer
For i = 2 To Worksheets.Count
For j = 2 To Worksheets.Count - 1
If Worksheets(j).Name > Worksheets(j + 1).Name Then
Worksheets(j).Move After:=Worksheets(j + 1)
End If
Next j
Next i
End Sub
The code will replace any invalid character which is not allowed in Sheet Name and replace it with nothing.
What you can do here is, delete all the Sheets except the LR Listing and run the macro which will insert all the tabs with relevant data and sort them in ascending order.
Oct 27 2020 11:59 PM
THANK YOU SO MUCH!
That worked!
I have been working on that for 2 weeks and you got it to work for me in a couple of hours!
I really appreciate this!
Alan
Oct 28 2020 01:37 AM
You're welcome Alan! Glad it worked as desired. :)
Oct 27 2020 11:33 PM
Solution
By sorting if you mean sorting the Sheet Tabs, you may replace the existing code with the following one...
Dim wsData As Worksheet
Sub CopyData()
Dim wsDest As Worksheet
Dim shName As String
Dim lr As Long
Dim lc As Long
Dim dlr As Long
Dim Rng As Range
Dim Cel As Range
Application.ScreenUpdating = False
Set wsData = Worksheets("LR Listing")
lr = wsData.Cells(Rows.Count, "C").End(xlUp).Row
lc = wsData.UsedRange.Columns.Count
Set Rng = wsData.Range("C2:C" & lr)
For Each Cel In Rng
If Cel.Value <> "" Then
shName = Cel.Value
shName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(shName, ":", ""), "/", ""), "\", ""), "?", ""), "*", ""), "[", ""), "]", "")
On Error Resume Next
Set wsDest = Worksheets(shName)
On Error GoTo 0
If wsDest Is Nothing Then
Set wsDest = Worksheets.Add(After:=Worksheets(Worksheets.Count))
wsDest.Name = shName
End If
dlr = wsDest.Cells(Rows.Count, "C").End(xlUp).Row + 1
wsData.Range(wsData.Cells(Cel.Row, 1), wsData.Cells(Cel.Row, lc)).Copy wsDest.Range("A" & dlr)
End If
Set wsDest = Nothing
Next Cel
Call SortSheetTabs
wsData.Activate
Application.ScreenUpdating = True
End Sub
Sub SortSheetTabs()
Dim i As Integer, j As Integer
For i = 2 To Worksheets.Count
For j = 2 To Worksheets.Count - 1
If Worksheets(j).Name > Worksheets(j + 1).Name Then
Worksheets(j).Move After:=Worksheets(j + 1)
End If
Next j
Next i
End Sub
The code will replace any invalid character which is not allowed in Sheet Name and replace it with nothing.
What you can do here is, delete all the Sheets except the LR Listing and run the macro which will insert all the tabs with relevant data and sort them in ascending order.