macrosinprogress

Option Explicit

Sub MakeABook()
    'Below, we will change the file names to whatever works for you. If you wanna change the name, change the corresponding entry below
    'For example, if you want your new sheet to be called "Clean Data", do this: newSheetName =  "Clean Data" (the title has to be in quotes)
    'For file name, you have to type it exactly with all spaces and THE CORRECT ending.
    Dim currentFileName As String
    Dim newSheetName As String
    Dim currentSheetName As String
    
    currentFileName = "report (1).xlsm"
    newSheetName = "Test Making New Sheet"
    currentSheetName = "data"
    
   'The bottom code is important because in the first two steps, we create a new worksheet and a new book object
   'In the "Set currentBook" part, what happens is we open and refer the the book we're using. Hence this is where we use the currentFileName
   'variable to open the book you specified earlier
   'Set newSheet into the add function gives us a new worksheet to play with
   
    Dim currentBook As Workbook
    Dim newSheet As Worksheet
    Dim dataSheet As Worksheet
    Set currentBook = Workbooks(currentFileName)
    Set newSheet = currentBook.Worksheets.Add(Type:=xlWorksheet, After:=Application.ActiveSheet)
    Set dataSheet = Worksheets(currentSheetName)
    With newSheet
        .Name = newSheetName
    End With
    
   'Cells(r,c) gets the cell at row r and column c
   'This is all hardcoded because we do not need a generalized way to get things in this project
    'modify the range to the one that is needed
   
    currentBook.Sheets(currentSheetName).Range("A3:B461").Copy _
    Destination:=newSheet.Range("A3:B461")
    currentBook.Sheets(currentSheetName).Range("HX3:MF461").Copy _
    Destination:=newSheet.Range("C3:DK461")
    
    
End Sub

Sub IsolateResponse()
    
    Dim currentFileName As String
    Dim newSheetName As String
    Dim currentSheetName As String
    
    'Below, we will change the file names to whatever works for you. If you wanna change the name, change the corresponding entry below
    'For example, if you want your new sheet to be called "Clean Data", do this: newSheetName =  "Clean Data" (the title has to be in quotes)
    'For file name, you have to type it exactly with all spaces and THE CORRECT ending.
    
    currentFileName = "report (1).xlsm"
    newSheetName = "Isolated Responses"
    currentSheetName = "Test Making New Sheet"
   
    Dim currentBook As Workbook
    Dim responseSheet As Worksheet
    Dim dataSheet As Worksheet
    Set currentBook = Workbooks(currentFileName)
    Set dataSheet = Worksheets(currentSheetName)
    Set responseSheet = currentBook.Worksheets.Add(Type:=xlWorksheet, After:=Application.ActiveSheet)
    
    With responseSheet
        .Name = newSheetName
    End With
    
    Dim word As String
    Dim responsePosition As Integer
    Dim tempPosition As Integer
    Dim endBracePosition As Integer
    Dim initResPos As Integer
    Dim cutStuff As String
    responsePosition = 1
    tempPosition = 1
    'In this stuff, the index starts at 1, not 0
    
    
    Dim origRowNum As Integer
    Dim origColNum As Integer
    Dim maxRowNum As Integer
    Dim maxColNum As Integer
    Dim rowNum As Integer
    Dim colNum As Integer
    
    'Change origRowNum and origColNum to the rows and columns that you start from and maxRowNum and maxColNum to the maximum
    'number of rows and columns
    
    origRowNum = 4
    origColNum = 3
    maxRowNum = 461
    maxColNum = 115
    
    rowNum = origRowNum
    colNum = origColNum
    
    Do While rowNum <= maxRowNum
        Do While colNum <= maxColNum
            
            'This code takes the value of each cell. Everytime it finds the word response, it will find the position of the endbrace and it would copy
            'everything inside the repsonse section
            
            word = currentBook.Sheets(currentSheetName).Cells(rowNum, colNum).Value
            Cells(rowNum, colNum).Value = ""
            If InStr(1, word, """response""") > 0 Then
                Do While tempPosition > 0
                    Cells(rowNum, colNum).Value = Cells(rowNum, colNum).Value & "{"
                    responsePosition = InStr(responsePosition + 1, word, """response""")
                    endBracePosition = InStr(responsePosition + 1, word, "}")
                    cutStuff = Mid(word, responsePosition, (endBracePosition - responsePosition + 1))
                    Cells(rowNum, colNum).Value = Cells(rowNum, colNum).Value & cutStuff
                    tempPosition = InStr(responsePosition + 1, word, """response""")
                Loop
            End If
            colNum = colNum + 1
            responsePosition = 1
            tempPosition = 1
            Loop
        rowNum = rowNum + 1
        colNum = origColNum
        Loop
        
    'This copies the names and headers on the top and sides
    'change the range to the range that is needed to copy

    currentBook.Sheets(currentSheetName).Range("A1:B461").Copy _
    Destination:=responseSheet.Range("A1:B461")
    currentBook.Sheets(currentSheetName).Range("A3:DK3").Copy _
    Destination:=responseSheet.Range("A3:DK3")
    
End Sub

Sub ExtractResponse()
    
    'This code is copied from above, it is used to create a new sheet
    Dim currentFileName As String
    Dim newSheetName As String
    Dim currentSheetName As String
    
    'Below, we will change the file names to whatever works for you. If you wanna change the name, change the corresponding entry below
    'For example, if you want your new sheet to be called "Clean Data", do this: newSheetName =  "Clean Data" (the title has to be in quotes)
    'For file name, you have to type it exactly with all spaces and THE CORRECT ending.
    
    currentFileName = "report (1).xlsm"
    
    newSheetName = "Extracted Responses"
    currentSheetName = "Isolated Responses"

    Dim currentBook As Workbook
    Dim responseSheet As Worksheet
    Dim dataSheet As Worksheet
    Set currentBook = Workbooks(currentFileName)
    Set dataSheet = Worksheets(currentSheetName)
    Set responseSheet = currentBook.Worksheets.Add(Type:=xlWorksheet, After:=Application.ActiveSheet)

    With responseSheet
        .Name = newSheetName
    End With
    
    'The following dims are here to instantiate the variables that will be used later on.
    'I will explain each of the variables as they pop up
    
    Dim testString As String
    Dim responsePosition As Integer
    Dim startBracePosition As Integer
    Dim endBracePosition As Integer
    Dim tempPosition As Integer
    Dim startPosition As Integer
    Dim bracePart As String
    Dim textPart As String
    Dim endResult As String
    Dim leftSquareBracket As Integer
    Dim rightSquareBracket As Integer
    Dim textPosition As Integer
    Dim tablePosition As Integer
    Dim responseWord As String
    Dim textWord As String
    Dim radioWord As String
    Dim tableWord As String
    Dim challengeWord As String
    Dim orWord As String
    Dim choicesWord As String
    Dim finalWord As String
    
    'In these cases, I assigned these specific values for these specific words
    'The way I did the isolation was that I checked for specific types in the words. The types I used were
    ' text, radio,tableinput,challenge and or. As you go down, each specific type has a specific way to extract the data.
    
    responseWord = """response"""
    textWord = """text"""
    radioWord = """radio"""
    tableWord = """tableinput"""
    challengeWord = """challenge"""
    orWord = """or"""
    choicesWord = """choices"""
    
    'Initializing the variables for use over here
    
    responsePosition = 0
    textPosition = 0
    tablePosition = 0
    startBracePosition = 0
    endBracePosition = 1
    tempPosition = 1
    startPosition = 0
    bracePart = ""
    textPart = ""
    endResult = "'"
    finalWord = ""
    
    Dim origRowNum As Integer
    Dim origColNum As Integer
    Dim maxRowNum As Integer
    Dim maxColNum As Integer
    Dim rowNum As Integer
    Dim colNum As Integer
    
    'Change origRowNum and origColNum to the rows and columns that you start from and maxRowNum and maxColNum to the maximum
    'number of rows and columns
    
    origRowNum = 4
    origColNum = 3
    maxRowNum = 461
    maxColNum = 115
    
    rowNum = origRowNum
    colNum = origColNum
    
    'What I did was I initialized variables that would help us loop through each data cell
    
    Do While rowNum <= maxRowNum
        Do While colNum <= maxColNum
            
            'In this double loop, we will iterate through each cell. In each cell, we will take the value of that cell.
            'Afterwards, if it is an empty string, we do nothing. Otherwise, we will loop through the string through each pair of end braces
            '(hence the use of bracepart). After that, we use type to check which type it is and then we use the respective statement to extract what we want.
            'finalWord is used to store the string that is placed into the new worksheet with extracted values
            
            finalWord = ""
            testString = currentBook.Sheets(currentSheetName).Cells(rowNum, colNum).Value
            Cells(rowNum, colNum).Value = ""
            
            If Len(testString) > 0 Then
                
                Do While tempPosition > 0
                    startBracePosition = InStr(tempPosition, testString, "{")
                    endBracePosition = InStr(tempPosition, testString, "}")
                    tempPosition = endBracePosition + 1
                    bracePart = Mid(testString, startBracePosition, (endBracePosition - startBracePosition + 1))
                    If InStr(1, bracePart, textWord) > 0 Then
                        If Not InStr(1, bracePart, "null") > 0 Then
                        textPosition = InStr(1, bracePart, textWord)
                        endBracePosition = InStr(1, bracePart, "}")
                           textPart = Mid(bracePart, textPosition + 7, (endBracePosition - textPosition - 7))
                        End If
                    ElseIf InStr(1, testString, radioWord) Then
                    'do nothing
                    ElseIf InStr(1, testString, tableWord) > 0 Or InStr(1, testString, orWord) > 0 Or InStr(1, testString, choicesWord) Then
                        leftSquareBracket = InStr(1, bracePart, "[")
                        rightSquareBracket = InStr(1, bracePart, "]")
                        textPart = Mid(bracePart, leftSquareBracket, (rightSquareBracket - leftSquareBracket + 1))
                    End If
                    
                    'We need to reset the positions to 0 or we will get errors, tempPosition is changed later
                    
                    textPosition = 0
                    tablePosition = 0
                    If InStr(tempPosition, testString, "{") = 0 Then
                        tempPosition = 0
                    End If
                    finalWord = finalWord & " + " & textPart
                Loop
                Cells(rowNum, colNum).Value = finalWord
            End If

        'It is important to remember to increment the loop indices as well as to reset the positions of what we used

        colNum = colNum + 1
        startBracePosition = 0
        endBracePosition = 1
        tempPosition = 1
        Loop
    rowNum = rowNum + 1
    colNum = origColNum
    Loop
    
    'This copies the left side and the top row of the sheets with the names and headers
    
    currentBook.Sheets(currentSheetName).Range("A1:B461").Copy _
    Destination:=responseSheet.Range("A1:B461")
    currentBook.Sheets(currentSheetName).Range("A3:DK3").Copy _
    Destination:=responseSheet.Range("A3:DK3")


End Sub