Results 1 to 4 of 4

Thread: vba to move data from a row to a column

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Junior Member
    Join Date
    Mar 2014
    Posts
    2
    Rep Power
    0

    Sample file attached, thanks.

    Thanks for the willingness to assist a newbie!
    Quote Originally Posted by Excel Fox View Post
    Robert, welcome to ExcelFox community.

    Can you post a sample file on a file sharing site, and post the link here. It would be better to have a look at the file, and propose a solution.
    Attached Files Attached Files

  2. #2
    Senior Member LalitPandey87's Avatar
    Join Date
    Sep 2011
    Posts
    222
    Rep Power
    15
    Here you go:

    Change constant variable values accordingly (Highlighted with red color)

    Code:
    Sub Lalit_Test()
    
        Dim varData()               As Variant
        Dim varFinalData()          As Variant
        Dim lngTotalDataCell        As Long
        Dim lngLoop                 As Long
        Dim lngLoop1                As Long
        Dim lngCount                As Long
        
        Const strDataRange          As String = "$A$6:$E$9"
        Const strDataShtName        As String = "Sheet1"
        Const strOutDataCell        As String = "$K$13"
        
        With ThisWorkbook.Worksheets(strDataShtName)
            .Range(strOutDataCell).Resize(.Rows.Count - .Range(strOutDataCell).Row + 1, 2).ClearContents
            varData = .Range(strDataRange).Value
            lngTotalDataCell = WorksheetFunction.CountA(.Range(strDataRange)) - .Range(strDataRange).Rows.Count
            ReDim varFinalData(1 To lngTotalDataCell, 1 To 2)
            lngCount = 0
            For lngLoop = LBound(varData) To UBound(varData)
                varFinalData(lngCount + 1, 1) = varData(lngLoop, LBound(varData))
                For lngLoop1 = LBound(varData) + 1 To UBound(varData, 2)
                    If LenB(Trim(varData(lngLoop, lngLoop1))) Then
                        lngCount = lngCount + 1
                        varFinalData(lngCount, 2) = varData(lngLoop, lngLoop1)
                    End If
                Next lngLoop1
            Next lngLoop
            If lngCount Then
                .Range(strOutDataCell).Resize(UBound(varFinalData), UBound(varFinalData, 2)).Value = varFinalData
            End If
        End With
        
        Erase varData
        Erase varFinalData
        lngTotalDataCell = Empty
        lngLoop = Empty
        lngLoop1 = Empty
        lngCount = Empty
    
    End Sub
    Last edited by LalitPandey87; 03-03-2014 at 09:23 AM.

Similar Threads

  1. Replies: 0
    Last Post: 12-24-2013, 01:36 PM
  2. Replies: 14
    Last Post: 08-08-2013, 04:53 PM
  3. VBA code to move row to new spreadsheet
    By cdurfey in forum Excel Help
    Replies: 6
    Last Post: 06-10-2013, 10:38 PM
  4. Replies: 7
    Last Post: 05-17-2013, 10:38 PM
  5. Replies: 1
    Last Post: 08-07-2012, 11:04 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •