Sub PSLAdjustPickAndScanLogRUN1()
'
' PSLAdjustPickAndScanLogRUN1 Macro
' This is the first macro that you run from the set. It calls on the rest of the macros and runs them in order to adjust the data in the worksheet for transposing.

'
    Application.Run "PSLMacro1InsertBibRowBelow"
    Application.Run "PSLMacro2InsertMFHDRowBelow"
    Application.Run "PSLMacro3MoveUnsuppressedDown"
    Application.Run "PSLMacro4MoveSuppressedDown"
    Application.Run "PSLMacro5MoveMFHDandBIBIDover"
    Application.Run "PSLMacro6CopyLeftBibIDLabel"
    Application.Run "PSLMacro7CopyLeftMFHDIDLabel"
    Application.Run "PSLMacro8LeftBibIDSuppressionLabel"
    Application.Run "PSLMacro9LeftMFHDSuppressionLabel"
End Sub


Sub PSLMacro1InsertBibRowBelow()
Dim c As Range
For Each c In Range("A:A")
 If c.Value Like "*Bib ID*" Then
 c.Offset(1, 0).EntireRow.Insert
 End If
Next c
End Sub

Sub PSLMacro2InsertMFHDRowBelow()
Dim c As Range
For Each c In Range("A:A")
 If c.Value Like "*MFHD ID*" Then
 c.Offset(1, 0).EntireRow.Insert
 End If
Next c
End Sub

Sub PSLMacro3MoveUnsuppressedDown()
  Dim booWorking As Boolean
  Dim rng As Range
  Set rng = Cells.SpecialCells(xlCellTypeLastCell)
  Set rng = rng.EntireRow.Range("B1")
  booWorking = True
  Do While booWorking
    If Left(rng.Value, 13) = "Unsuppressed" Then
      rng.Offset(1).Value = rng.Value
      rng.Value = ""
    End If
    If rng.Row = 1 Then booWorking = False
    If rng.Row > 1 Then Set rng = rng.Offset(-1)
  Loop
End Sub

Sub PSLMacro4MoveSuppressedDown()
  Dim booWorking As Boolean
  Dim rng As Range
  Set rng = Cells.SpecialCells(xlCellTypeLastCell)
  Set rng = rng.EntireRow.Range("B1")
  booWorking = True
  Do While booWorking
    If Left(rng.Value, 13) = "Suppressed" Then
      rng.Offset(1).Value = rng.Value
      rng.Value = ""
    End If
    If rng.Row = 1 Then booWorking = False
    If rng.Row > 1 Then Set rng = rng.Offset(-1)
  Loop
End Sub


Sub PSLMacro5MoveMFHDandBIBIDover()
Dim myrange, cell As Range
Set myrange = ActiveSheet.Range("A:A", Range("A:A").End(xlDown))
For Each cell In myrange
    If Left(cell.Value, 7) = "MFHD ID" Then
        cell.Offset(0, 1).Value = cell.Value
        cell.ClearContents
    ElseIf Left(cell.Value, 6) = "Bib ID" Then
        cell.Offset(0, 1).Value = cell.Value
        cell.ClearContents
    End If
Next cell
End Sub

Sub PSLMacro6CopyLeftBibIDLabel()
    Dim FindString As String
    Dim FindCell As Range
        
    FindString = "Bib ID"
    If FindString = "" Then Exit Sub
    
    For Each FindCell In Range(ActiveSheet.Range("B1"), ActiveSheet.Range("B300000").End(xlUp)).Cells
        If InStr(FindCell, FindString) > 0 Then FindCell.Offset(0, -1) = FindString
    Next FindCell
End Sub


Sub PSLMacro7CopyLeftMFHDIDLabel()
    Dim FindString As String
    Dim FindCell As Range
        
    FindString = "MFHD ID"
    If FindString = "" Then Exit Sub
    
    For Each FindCell In Range(ActiveSheet.Range("B1"), ActiveSheet.Range("B300000").End(xlUp)).Cells
        If InStr(FindCell, FindString) > 0 Then FindCell.Offset(0, -1) = FindString
    Next FindCell
End Sub

Sub PSLMacro8LeftBibIDSuppressionLabel()
    Dim FindString As String
    Dim FindCell As Range
        
    FindString = "Bib ID"
    If FindString = "" Then Exit Sub
    
    For Each FindCell In Range(ActiveSheet.Range("B1"), ActiveSheet.Range("B300000").End(xlUp)).Cells
        If InStr(FindCell, FindString) > 0 Then FindCell.Offset(1, -1) = "BibSuppression"
    Next FindCell
End Sub

Sub PSLMacro9LeftMFHDSuppressionLabel()
    Dim FindString As String
    Dim FindCell As Range
        
    FindString = "MFHD ID"
    If FindString = "" Then Exit Sub
    
    For Each FindCell In Range(ActiveSheet.Range("B1"), ActiveSheet.Range("B300000").End(xlUp)).Cells
        If InStr(FindCell, FindString) > 0 Then FindCell.Offset(1, -1) = "MFHDSuppression"
    Next FindCell
End Sub

Sub PSLConvertPickAndScanLogRUN2()
'This is the macro you run second to transpose the data from rows to columns in a new worksheet within the workbook
Dim ws1 As Worksheet, ws2 As Worksheet, LR As Long, i As Long, j As Long
Set ws1 = ActiveSheet
Sheets.Add
Set ws2 = ActiveSheet
ws2.Range("A1:AA1").Value = Array("Item ID:", "Barcode:", "Title:", "Enum/Chron:", "Call Number:", "Call Number Prefix:", "Holding Location:", "Permanent Location:", "Temporary Location:", "Permanent Type:", "Temporary Type:", "Media Type:", "Item Status:", "Statistical Categories:", "Magnetic Media:", "Sensitize:", "Free Text:", "Copy Number:", "Pieces Number:", "Price:", "MFHD ID", "MFHD Suppression", "Bib ID", "BibSuppression", "Update Bib Status:", "Update Holding Status:", "Update Item Status:")
j = 1
With ws1
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        If .Range("A" & i).Value = "Item ID:" Then j = j + 1
        Select Case .Range("A" & i).Value
            Case "Item ID:": ws2.Cells(j, 1).Value = .Range("B" & i).Value
            Case "Barcode:": ws2.Cells(j, 2).Value = .Range("B" & i).Value
            Case "Title:": ws2.Cells(j, 3).Value = .Range("B" & i).Value
            Case "Enum/Chron:": ws2.Cells(j, 4).Value = .Range("B" & i).Value
            Case "Call Number:": ws2.Cells(j, 5).Value = .Range("B" & i).Value
            Case "Call Number Prefix:": ws2.Cells(j, 6).Value = .Range("B" & i).Value
            Case "Holding Location:": ws2.Cells(j, 7).Value = .Range("B" & i).Value
            Case "Permanent Location:": ws2.Cells(j, 8).Value = .Range("B" & i).Value
            Case "Temporary Location:": ws2.Cells(j, 9).Value = .Range("B" & i).Value
            Case "Permanent Type:": ws2.Cells(j, 10).Value = .Range("B" & i).Value
            Case "Temporary Type:": ws2.Cells(j, 11).Value = .Range("B" & i).Value
            Case "Media Type:": ws2.Cells(j, 12).Value = .Range("B" & i).Value
            Case "Item Status:": ws2.Cells(j, 13).Value = .Range("B" & i).Value
            Case "Statistical Categories:": ws2.Cells(j, 14).Value = .Range("B" & i).Value
            Case "Magnetic Media:": ws2.Cells(j, 15).Value = .Range("B" & i).Value
            Case "Sensitize:": ws2.Cells(j, 16).Value = .Range("B" & i).Value
            Case "Free Text:": ws2.Cells(j, 17).Value = .Range("B" & i).Value
            Case "Copy Number:": ws2.Cells(j, 18).Value = .Range("B" & i).Value
            Case "Pieces Number:": ws2.Cells(j, 19).Value = .Range("B" & i).Value
            Case "Price:": ws2.Cells(j, 20).Value = .Range("B" & i).Value
            Case "MFHD ID": ws2.Cells(j, 21).Value = .Range("B" & i).Value
            Case "MFHDSuppression": ws2.Cells(j, 22).Value = .Range("B" & i).Value
            Case "Bib ID": ws2.Cells(j, 23).Value = .Range("B" & i).Value
            Case "BibSuppression": ws2.Cells(j, 24).Value = .Range("B" & i).Value
            Case "Update Bib Status:": ws2.Cells(j, 25).Value = .Range("B" & i).Value
            Case "Update Holding Status:": ws2.Cells(j, 26).Value = .Range("B" & i).Value
            Case "Update Item Status:": ws2.Cells(j, 27).Value = .Range("B" & i).Value
        End Select
    Next i
End With
End Sub