Results 1 to 4 of 4

Thread: reformat

  1. #1
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts

    reformat

    hi all,

    i have a huge data that has the format in the attachment column a2:e5 that i want to expand and changed into the format g2:k10. any suggestions....

    TIA
    Attached Files Attached Files
    TIA
    dubdub

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    How about this code?
    Code:
    Option Explicit
    Sub ReformatData()
      Dim wCurrent As Worksheet
      Dim wWanted As Worksheet
      Dim lRowCurr As Long
      Dim lLastRow As Long
      Dim lRowWant As Long
      Dim sCell As String
      Dim sPrefix As String
      Dim sSuffix As String
      Dim iGroups As Integer
      Dim iStart As Integer
      Dim iEnd As Integer
      Dim iCol As Integer
      Dim i As Integer
      
      Set wCurrent = ActiveSheet
      Set wWanted = Worksheets.Add
      With wWanted
        With .Range("A1:E1")
          .Merge
          .HorizontalAlignment = xlCenter
        End With
        .Range("a1") = "Wanted Layout"
        .Range("B2:E2") = Array("x", "y", "z", "w")
      End With
      lRowWant = 3
      With wCurrent
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lRowCurr = 3 To lLastRow
          sCell = .Cells(lRowCurr, 1) & ","
          iGroups = Len(sCell) - _
            Len(Application.WorksheetFunction.Substitute(sCell, ",", ""))
          iStart = InStr(sCell, "-")
          sPrefix = Left(sCell, iStart)
          For i = 1 To iGroups
            iEnd = InStr(iStart + 1, sCell, ",") - iStart
            sSuffix = Mid(sCell, iStart + 1, iEnd - 1)
            wWanted.Cells(lRowWant, 1) = sPrefix & sSuffix
            For iCol = 2 To 5
              If Not IsEmpty(.Cells(lRowCurr, iCol)) Then
                wWanted.Cells(lRowWant, iCol) = .Cells(lRowCurr, iCol) / iGroups
              End If
            Next
            lRowWant = lRowWant + 1
            iStart = iStart + iEnd
          Next
        Next
      End With
    End Sub
    Steve

  3. #3
    Super Moderator jwitalka's Avatar
    Join Date
    Dec 2009
    Location
    Minnesota
    Posts
    6,792
    Thanks
    117
    Thanked 798 Times in 719 Posts
    Did you try using the format painter? Select the source format cells, click on the format painter icon, and hold the left mouse button down over the destination cells.

    Jerry

  4. #4
    3 Star Lounger
    Join Date
    Jul 2005
    Location
    Bahrain
    Posts
    373
    Thanks
    1
    Thanked 0 Times in 0 Posts
    many....many...thanks Steve,

    thanks to the help from all,and you in particular.

    dubdub
    TIA
    dubdub

Posting Permissions

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