• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 291
  • Last Modified:

How would I automate the transposing of the data in the attached xlsx file?

I would like to automate the transposing of the data in the attached file so that for example,
the data on sheet "d" is transformed into the "resultsSHEET d" format. Each sheet in the file would be transformed in the same manner -  much more user friendly -

Thanks
eecog.xlsx
0
PDSWSS
Asked:
PDSWSS
  • 3
1 Solution
 
andrewssd3Commented:
Try this - I have assumed there are always exactly 14 questions - this would need a rework if it could vary.
Option Explicit

Public Sub Test()

    Call TransposeIt(ActiveWorkbook.Worksheets("d"))

End Sub

Public Sub TransposeIt(ByVal wks As Excel.Worksheet)

    Dim strSheet As String
    Dim results As Excel.Worksheet
    Dim rngIn As Excel.Range
    Dim rngWork As Excel.Range
    Dim rngOut As Excel.Range
    
    Const lngNUMQs As Long = 14         ' number of questions
    
    strSheet = "ResultsSHEET " & wks.Name

    On Error Resume Next
    Set results = ActiveWorkbook.Worksheets(strSheet)
    On Error GoTo 0
    
    ' create the output sheet, or delete the contents of the original sheet
    If results Is Nothing Then
        Set results = ActiveWorkbook.Worksheets.Add
        results.Name = strSheet
    Else
        results.UsedRange.ClearContents
    End If
    
    
    results.Cells(1).Value = "Subject id"
    ' get the question numbers
    Set rngWork = wks.Cells(2, 3).Resize(lngNUMQs, 1)
    results.Cells(1, 2).Resize(1, lngNUMQs).Value = Application.WorksheetFunction.Transpose(rngWork)
    
    ' now put in the subject id
    Set rngOut = results.Cells(2, 1)

    Set rngIn = wks.UsedRange.Cells(2, 1)
    
    ' loop while still data
    Do While Len(Trim$(rngIn.Value)) > 0
        rngOut.Value = rngIn.Value          ' the subject id
        Set rngWork = rngIn.Offset(0, 1).Resize(lngNUMQs, 1)
        rngOut.Offset(0, 1).Resize(1, lngNUMQs).Value = Application.WorksheetFunction.Transpose(rngWork)
        
        Set rngOut = rngOut.Offset(1, 0)            ' skip to next output row
        Set rngIn = rngIn.Offset(lngNUMQs, 0)       ' skip to next block
    Loop

End Sub

Open in new window

0
 
PDSWSSAuthor Commented:
Excellent answer. Worked as requested.
Question - if  >  or  <  14

Would  changing the "14" in this line "Const lngNUMQs As Long = 14"
to the correct number of questions suffice?


Thanks
0
 
PDSWSSAuthor Commented:
Just tested and see that changing that number works.
Will give you the points now. Thanks again.
0
 
PDSWSSAuthor Commented:
Great job!
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now