[Solved] Workbook main page data sorted to sheets by name

[mlgrant70]

I need to code to move and keep a line from the main worksheet to the tab with the technician's name. A copy of the workbook is attached.

 

[mizbahulabedin]

I need to code to move and keep a line from the main worksheet to the tab with the technician's name. A copy of the workbook is attached.

Hello Mlgrant70,

Welcome to ExcelDemy Forum. Thanks for reaching out and posting your question. It would be a great help if you could provide more information regarding this problem.

If I’m not wrong you want to include information on each technician in a separate tab according to their name from the main worksheet you had already given us. The necessary information of that particular technician will show on that sheet name tab.
To do that,

• Go to the Microsoft Visual Basic window.
• Insert a Module and paste the following code there.

Sub LoopThroughSheetsAndPasteData()

    Dim ws, wsMain As Worksheet
    Dim filterCriteria As String
    Dim lastRow As Long

    Set wsMain = ThisWorkbook.Sheets("VGT Log")

    wsMain.Cells.UnMerge

    lastRow = wsMain.Cells(Rows.Count, "A").End(xlUp).Row

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "VGT Log" Then
            filterCriteria = ws.Name
            ws.Cells.UnMerge
            With wsMain
                .AutoFilterMode = False
                .Range("D3").AutoFilter Field:=4, Criteria1:=filterCriteria
                .Range("A4:K" & lastRow).Copy
            End With
            ws.Range("A4").PasteSpecial xlPasteValues
        End If
    Next ws

    ThisWorkbook.Sheets("VGT Log").AutoFilterMode = False

End Sub

• Then run the code.
• Now you can see the information of each technician in a separate you have already created according to their name.

For a better understanding, you can see the screenshot below. From the main worksheet, we have found this data of Nathan Grote. The data is shown in a separate tab.

Note: While naming the tab/worksheet use the exact same name of the technician as provided in the main sheet of your workbook.
I hope this answer will help you to solve your problem. Please let us know if you have any other queries.

Regards
ExcelDemy team

 

[mlgrant70]

This worked wonderfully! Just need to clean up the sheet some and it will be good to go. Thanks so much!

 

[mlgrant70]

One thing I did notice if the technician is not on the main sheet, it copies that whole sheet under their name. I would like their sheet to remain blank. For example: Noah Radcliff has nothing in VGT Log, but when you run the macro it copies the whole VGT Log information to his tab.

 

[mizbahulabedin]

One thing I did notice if the technician is not on the main sheet, it copies that whole sheet under their name. I would like their sheet to remain blank. For example: Noah Radcliff has nothing in VGT Log, but when you run the macro it copies the whole VGT Log information to his tab.

Hello Mlgrant70,

Welcome to ExcelDemy Forum. Thanks for replying. You want the sheet blank if the technician’s name is not on the main sheet. For example: Noah Radcliff has nothing in the “VGT Log” sheet/tab so the Sheet named “Noah Radcliff” will remain empty.
To do that use the VBA code given below:

Sub LoopThroughSheetsAndPasteDataWithArray()
    
    Dim ws As Worksheet
    Dim wsMain As Worksheet
    Dim filterCriteria As String
    Dim lastRow As Long
    Dim uniqueValues() As Variant
    Dim i As Long

    UniqueValuesToArray uniqueValues

    Set wsMain = ThisWorkbook.Sheets("VGT Log")

    wsMain.Cells.UnMerge
    
    Call SortSheetsByNameAndMove

    lastRow = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "VGT Log" Then
            filterCriteria = ws.Name

            If Not IsInArray(filterCriteria, uniqueValues) Then
                ws.Cells.ClearContents
            End If

            ws.Cells.UnMerge
            With wsMain
                .AutoFilterMode = False
                .Range("D3").AutoFilter Field:=4, Criteria1:=filterCriteria
                If Application.WorksheetFunction.Subtotal(103, .Range("D4:D" & lastRow)) > 1 Then
                    .Range("A4:K" & lastRow).Copy
                    ws.Range("A4").PasteSpecial xlPasteValues
                End If
            End With
        End If

    Next ws

    ThisWorkbook.Sheets("VGT Log").AutoFilterMode = False

End Sub


Function IsInArray(value As Variant, arr As Variant) As Boolean
    
    Dim element As Variant
    For Each element In arr
        If element = value Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False

End Function

Sub UniqueValuesToArray(ByRef uniqueValues() As Variant)
    
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim value As Variant
    Dim isUnique As Boolean
    Dim i As Long
    
    Set ws = ThisWorkbook.Sheets("VGT Log")
    
    lastRow = ws.Cells(Rows.Count, "D").End(xlUp).Row

    ReDim uniqueValues(1 To lastRow - 3)

    i = 1

    For Each cell In ws.Range("D4:D" & lastRow)
        value = cell.value
        isUnique = True

        For j = 1 To i - 1
            If uniqueValues(j) = value Then
                isUnique = False
                Exit For
            End If
        Next j

        If isUnique Then
            uniqueValues(i) = value
            i = i + 1
        End If
    Next cell

    ReDim Preserve uniqueValues(1 To i - 1)

End Sub

Sub SortSheetsByNameAndMove()
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Integer, j As Integer
    Dim sheetNames() As String
    Dim vgtLogIndex As Integer
    Dim unknownIndex As Integer

    Set wb = ThisWorkbook

    ReDim sheetNames(1 To wb.Sheets.Count)
    i = 1
    For Each ws In wb.Sheets
        sheetNames(i) = ws.Name
        i = i + 1
    Next ws

    For i = 1 To UBound(sheetNames)
        For j = i + 1 To UBound(sheetNames)
            If UCase(sheetNames(i)) > UCase(sheetNames(j)) Then
                Dim tempName As String
                tempName = sheetNames(i)
                sheetNames(i) = sheetNames(j)
                sheetNames(j) = tempName
            End If
        Next j
    Next i

    For i = 1 To UBound(sheetNames)
        wb.Sheets(sheetNames(i)).Move After:=wb.Sheets(wb.Sheets.Count)
    Next i

    vgtLogIndex = 0
    unknownIndex = 0
    For i = 1 To UBound(sheetNames)
        If sheetNames(i) = "VGT Log" Then
            vgtLogIndex = i
        ElseIf sheetNames(i) = "Unknown" Then
            unknownIndex = i
        End If
    Next i

    If vgtLogIndex > 0 Then
        wb.Sheets(sheetNames(vgtLogIndex)).Move Before:=wb.Sheets(1)
    End If

    If unknownIndex > 0 Then
        wb.Sheets(sheetNames(unknownIndex)).Move Before:=wb.Sheets(2)
    End If

End Sub

• In the image below you can see that the worksheet named “Noah Radcliff” is blank.

Note: This VBA code will also sort your worksheets alphabetically. You don’t need to do sorting manually.

Regards
ExcelDemy team