Consulting

Results 1 to 9 of 9

Thread: Solved: How to add continuous value under one set of column

  1. #1
    VBAX Regular
    Joined
    Dec 2009
    Posts
    6
    Location

    Solved: How to add continuous value under one set of column

    For Example,
    i have 4 columns first column cell have value = 2, second column cell having value = 3, third column cell having value = 5 and last column cell having value = 6.
    i want the result to be like this
    2 5
    3 6

    that means 2 and 3 are continuous so under 2 the value 3 has to come, since 4 is not available the value 5 should be in other column and its continuous 6 to be under 5.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,445
    Location
    Just one row or more? IF more, what happend then?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    Site Admin VBAX Guru Simon Lloyd's Avatar
    Joined
    Sep 2005
    Location
    UK
    Posts
    3,008
    Location
    Also are you looking for a formula solution or vba?, what does your worksheet structure look like? how and where would you want to present the result? what would be the range of the series?
    Regards,
    Simon
    Please read this before cross posting!
    In the unlikely event you didn't get your answer here try Microsoft Office Discussion @ The Code Cage
    If I have seen further it is by standing on the shoulders of giants.
    Isaac Newton, Letter to Robert Hooke, February 5, 1675 English mathematician & physicist (1642 - 1727)

  4. #4
    VBAX Regular
    Joined
    Dec 2009
    Posts
    6
    Location
    [quote=kar6842]For Example,
    Please find the attachemnet for Better understanding.
    I am looking for a VBA solution.

  5. #5
    VBAX Regular
    Joined
    Dec 2009
    Posts
    6
    Location
    Please find the attachemnet for Better understanding.
    I am looking for a VBA solution.

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,445
    Location
    What determines that 2,3,4,5 and 6 all go in the same column?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  7. #7
    Mac Moderator VBAX Guru mikerickson's Avatar
    Joined
    May 2007
    Location
    Davis CA
    Posts
    2,776
    This should do what you want.
    [vba]Sub test()
    Dim sourceSheet As Worksheet, destinationSheet As Worksheet
    Dim sourceRow As Long, destinationStartRow As Long
    Dim sourceCheckRange As Range, sourceCheckCell As Range, sourceChunk As Range
    Dim destinationColumn As Long, lastCheckVal As Long
    Dim destinationCell As Range

    Set sourceSheet = ThisWorkbook.Sheets("Input"): Rem adjust
    Set destinationSheet = ThisWorkbook.Sheets("Output"): Rem adjust
    sourceRow = 4: Rem adjust
    destinationStartRow = 4: Rem adjust

    With sourceSheet.Rows(sourceRow)
    Set sourceCheckRange = Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))
    End With

    With destinationSheet
    Range(.Range("A1"), .UsedRange).Offset(destinationStartRow - 1, 0).Clear
    End With

    destinationColumn = 0
    lastCheckVal = -2

    For Each sourceCheckCell In sourceCheckRange
    Rem if non-sequetial, next destination column
    If numberFromString(CStr(sourceCheckCell.Value)) <> lastCheckVal + 1 Then
    destinationColumn = destinationColumn + 1
    End If
    lastCheckVal = numberFromString(CStr(sourceCheckCell.Value))

    Rem copy data to destination column
    With sourceCheckCell.EntireColumn
    Set sourceChunk = Range(sourceCheckCell, .Cells(.Rows.Count, 1).End(xlUp))
    End With

    With destinationSheet.Columns(destinationColumn)
    Set destinationCell = destinationSheet.Cells(Application.Max(destinationStartRow, _
    .Cells(.Rows.Count, 1).End(xlUp).Row + 1), destinationColumn)
    End With

    sourceChunk.Copy Destination:=destinationCell

    Next sourceCheckCell
    End Sub

    Function numberFromString(aString As String) As Long
    Dim i As Long
    For i = 1 To Len(aString)
    If Val(Mid(aString, i)) <> 0 Then
    numberFromString = Val(Mid(aString, i))
    Exit Function
    End If
    Next i
    End Function
    [/vba]

  8. #8
    VBAX Regular
    Joined
    Dec 2009
    Posts
    6
    Location

    Thumbs up

    Thank You Very Much. you did what i expected. thank you so much

  9. #9
    VBAX Regular
    Joined
    Dec 2009
    Posts
    6
    Location

    .Exe file Creation in Excel

    how to create a .exe file using Excel with the help of VB?

Posting Permissions

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