Page 1 of 2 12 LastLast
Results 1 to 15 of 21
  1. #1
    Lounger
    Join Date
    Apr 2014
    Posts
    25
    Thanks
    19
    Thanked 0 Times in 0 Posts

    VBA macro code for grouping data based on 2-hour time intervals

    Hello Experts,

    I need a VBA macro code to get the output like in the excel file which I have attached with this thread. Which means, I need to group the data for every two hours. in the output I need all 4 cols namely A, B, C, D along with extra col namely, interval based on which I need these groupings to be done..

    I did manually for your kind reference and easy understanding... please find the attachment.... in the excel sheet I have explained still more clearly, please refer that...

    A kind request, the code has to be really flexible so that it works for all dates and times in the files. because like this I have to do for 2000 files.....
    I hope I am clear and I am not confusing you experts and also I hope for experts like you this code will be easier to write...
    for further clarification, I am very much ready to answer you...

    Looking forward for the positive reply..... please do the needful... please help me in this, i need very urgently...
    Thank you,

    With kind regards,
    Dharani.

    original link: http://www.vbaexpress.com/forum/show...N-2-HOURS-TIME
    As per the general forum rules, i am posting my thread here... please help me...
    In vba express forum, i posted this few days back, but i couldn't get reply that's y i posted in this forum as well... i need answer for this thread very urgently....

    thank you...
    Attached Files Attached Files
    Last edited by dharani suresh; 2014-04-28 at 03:53. Reason: following the forum rules... thank you,,,

  2. Subscribe to our Windows Secrets Newsletter - It's Free!

    Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,854
    Thanks
    0
    Thanked 176 Times in 162 Posts
    Cross-posted at: http://www.msofficeforums.com/excel-...html#post62851
    For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  4. #3
    Lounger
    Join Date
    Apr 2014
    Posts
    25
    Thanks
    19
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by macropod View Post
    YES YOU ARE RIGHT, i will remove my thread from that forum... but i don't know how to do that can you please explain me...

  5. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,202
    Thanks
    14
    Thanked 330 Times in 323 Posts
    Does this code do what you want? It creates a new sheet with the new output. It does not touch the source.

    Steve
    Code:
    Option Explicit
    Sub ExtractData()
      Dim wSource As Worksheet
      Dim wDest As Worksheet
      Dim lLastRow As Long
      Dim lRowSource As Long
      Dim lRowDest As Long
      Dim vArray As Variant
      Dim iInt As Integer
      Dim i As Integer
      Dim bFilling As Boolean
     
      vArray = Array("0-2", "2-4", "4-6", "6-8", "8-10", "10-12", _
        "12-14", "14-16", "16-18", "18-20", "20-22", "22-24")
      Set wSource = ActiveSheet
      Set wDest = Worksheets.Add
      
      With wSource
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        wDest.Cells(1, 1) = .Cells(1, 1)
        wDest.Cells(1, 2) = "Interval"
        wDest.Cells(1, 3) = .Cells(1, 2)
        wDest.Cells(1, 4) = .Cells(1, 3)
        wDest.Cells(1, 5) = .Cells(1, 4)
        lRowSource = 2
        lRowDest = 2
        i = 0
        bFilling = True
        Do Until lRowSource > lLastRow
          iInt = Int(.Cells(lRowSource, 3) * 12)
          If wDest.Cells(lRowDest - 1, 2) <> vArray(iInt) _
            And wDest.Cells(lRowDest - 1, 3) <> wDest.Cells(lRowDest, 3) _
            Or Not (bFilling) Then
            wDest.Cells(lRowDest, 1) = .Cells(lRowSource, 1)
            wDest.Cells(lRowDest, 2) = "'" & vArray(i)
          Else
            i = i - 1
          End If
          wDest.Cells(lRowDest, 3) = .Cells(lRowSource, 2)
          If i >= iInt And bFilling Then
            wDest.Cells(lRowDest, 4) = .Cells(lRowSource, 3)
            wDest.Cells(lRowDest, 5) = .Cells(lRowSource, 4)
            lRowSource = lRowSource + 1
          End If
          i = i + 1
          If i > 11 Then
            i = 0
            If Not bFilling Then lRowSource = lRowSource + 1
            bFilling = True
          Else
            If wDest.Cells(lRowDest, 3) <> .Cells(lRowSource, 2) Then
              lRowSource = lRowSource - 1
              bFilling = False
            End If
          End If
          lRowDest = lRowDest + 1
        Loop
        .Range("B2:D2").Copy
        wDest.Range("C2:E" & lRowDest).PasteSpecial Paste:=xlPasteFormats
        wDest.Range("A:E").EntireColumn.AutoFit
      End With
    End Sub

  6. The Following User Says Thank You to sdckapr For This Useful Post:

    dharani suresh (2014-04-29)

  7. #5
    Lounger
    Join Date
    Apr 2014
    Posts
    25
    Thanks
    19
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    Does this code do what you want? It creates a new sheet with the new output. It does not touch the source.

    Steve
    Code:
    Option Explicit
    Sub ExtractData()
      
        wDest.Range("A:E").EntireColumn.AutoFit
      End With
    End Sub
    Hello sdckapr,
    Great!!!!!!!!!!!! awesome..... exact output i am getting.... Thanks a lot... thank you so much for spending your valuable time in helping me...

    Actually many people here they tried to write this code, but no one succeeded, but u made it... u r really great... Thank you so much...
    The code is really fantastic... THE CODE IS GIVING ME CORRECT OUTPUT BUT I HAVE SOME PROBLEM INITIALLY....like if there are two values which falls in the same interval, the code is perfect, if there are THREE VALUES, the interval is getting shifted little down ... now i need all three values to be fall in same interval. for better understanding please see the attached excel file... ....

    For me one doubt, in future i may change the 0-2 2-4 interval as 0-1, 1-2, 2-3 interval also, that is i may reduce the 2 hours difference in to 1 hour difference also, can you please tell me, for this in which part of code should i edit?? because again i must not come and disturb you... that's y...
    Looking forward for the favorable reply...

    My heartfelt thanks to you for spending your valuable time and helping me to solve this problem...

    With Kind Regards,
    Dharani.
    Attached Files Attached Files
    Last edited by dharani suresh; 2014-04-30 at 22:28.

  8. #6
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,202
    Thanks
    14
    Thanked 330 Times in 323 Posts
    Try this. I think I fixed the logic issues. For the future 1 vs 2 hour, I set it up to be based on the array you create. It currently uses the 12 entry (2 hours) for the 2 hours, but if you remove the comment from the 24 entry line it should work for every hour.

    Code:
    Option Explicit
    Sub ExtractData2()
      Dim wSource As Worksheet
      Dim wDest As Worksheet
      Dim lLastRow As Long
      Dim lRowSource As Long
      Dim lRowDest As Long
      Dim vArray As Variant
      Dim iInt As Integer
      Dim iIntPrev As Integer
      Dim i As Integer
      Dim bFilling As Boolean
     
      'Use this for 2 hours
      vArray = Array("0-2", "2-4", "4-6", "6-8", "8-10", "10-12", _
        "12-14", "14-16", "16-18", "18-20", "20-22", "22-24")
      'Use this for 1 hour
      vArray = Array("0-1", "1-2", "2-3", "3-4", "4-5", "5-6", _
        "6-7", "7-8", "8-9", "9-10", "10-11", "11-12", _
        "12-13", "13-14", "14-15", "15-16", "16-17", "17-18", _
        "18-19", "19-20", "20-21", "21-22", "22-23", "23-24")
      
      Set wSource = ActiveSheet
      Set wDest = Worksheets.Add
      
      With wSource
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        wDest.Cells(1, 1) = .Cells(1, 1)
        wDest.Cells(1, 2) = "Interval"
        wDest.Cells(1, 3) = .Cells(1, 2)
        wDest.Cells(1, 4) = .Cells(1, 3)
        wDest.Cells(1, 5) = .Cells(1, 4)
        lRowSource = 2
        lRowDest = 2
        iIntPrev = -1
        i = LBound(vArray)
        bFilling = True
        Do Until lRowSource > lLastRow
          iInt = Int(.Cells(lRowSource, 3) * (UBound(vArray) - LBound(vArray) + 1))
          If .Cells(lRowSource, 2) = .Cells(lRowSource + 1, 2) _
            And i > iInt Then i = iInt
          If iIntPrev <> i _
            And wDest.Cells(lRowDest - 1, 3) <> wDest.Cells(lRowDest, 3) _
            Or Not (bFilling) Then
    
            wDest.Cells(lRowDest, 1) = .Cells(lRowSource, 1)
            wDest.Cells(lRowDest, 2) = "'" & vArray(i)
            iIntPrev = i
          End If
          wDest.Cells(lRowDest, 3) = .Cells(lRowSource, 2)
          If i >= iInt And bFilling Then
            wDest.Cells(lRowDest, 4) = .Cells(lRowSource, 3)
            wDest.Cells(lRowDest, 5) = .Cells(lRowSource, 4)
            lRowSource = lRowSource + 1
            i = iInt
          End If
          i = i + 1
          If i > UBound(vArray) Then
            i = LBound(vArray)
            If Not bFilling Then lRowSource = lRowSource + 1
            bFilling = True
          Else
            If wDest.Cells(lRowDest, 3) <> .Cells(lRowSource, 2) Then
              lRowSource = lRowSource - 1
              bFilling = False
            End If
          End If
          lRowDest = lRowDest + 1
        Loop
        .Range("B2:D2").Copy
        wDest.Range("C2:E" & lRowDest).PasteSpecial Paste:=xlPasteFormats
        wDest.Range("A:E").EntireColumn.AutoFit
      End With
      MsgBox "Done"
    End Sub
    Steve
    Last edited by sdckapr; 2014-05-01 at 06:30.

  9. The Following User Says Thank You to sdckapr For This Useful Post:

    dharani suresh (2014-04-30)

  10. #7
    Lounger
    Join Date
    Apr 2014
    Posts
    25
    Thanks
    19
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    Try this. I think I fixed the logic issues. For the future 1 vs 2 hour, I set it up to be based on the array you create. It currently uses the 12 entry (2 hours) for the 2 hours, but if you remove the comment from the 24 entry line it should work for every hour.

    Code:
    Option Explicit
    Sub ExtractData2()
      Dim wSource As Worksheet
      Dim wDest As Worksheet
      Dim lLastRow As Long
     
    End Sub
    Steve
    Hello Steve,
    Thank you so much Steve....!!!!!!!!! the code is giving exactly what i need... thanks for your continuous effort in helping me..
    the code is awesome....
    In spite of your busy schedules, you managed to help me... Thank you once again for spending your valuable time and helping me... My heartfelt thanks to you...

    LITTLE MODIFICATION: VERY SMALL ONE...
    I need the same output only but now i have added extra cols for which the same process has to be done... from the input tab, the a,b,c ,d col is going to be same so this is not a big work for you... likewise for the same intervals the data has to be get separated but with extra cols...
    for this i tried doing this,
    in the code,
    i changed the col ranges like
    earlier it was like this,
    Code:
     Loop
        .Range("B2:D2").Copy
        wDest.Range("C2:E" & lRowDest).PasteSpecial Paste:=xlPasteFormats
        wDest.Range("A:E").EntireColumn.AutoFit
      End With
      MsgBox "Done"
    End Sub
    Now, i changed like this, since i added many extra rows for which the same process has to done...
    Code:
     Loop
        .Range("C2:M2").Copy
        wDest.Range("D2:N" & lRowDest).PasteSpecial Paste:=xlPasteFormats
        wDest.Range("A:N").EntireColumn.AutoFit
      End With
      MsgBox "Done"
    End Sub
    But i am getting error saying that,
    run time error : 6
    overflow

    please help me... please don't think that i am troubling you a lot.... for your easy understanding and also not to trouble you much, i have attached the excel sheet please refer that... this is not a big work for you i m sure because same process has to be done but with few more extra cols thats all...
    please help me..
    Looking forward for the positive reply...

    With Kind Regards,
    Dharani.

    p.s., but please note that i have just changed the format of first two cols a and b.
    Attached Files Attached Files
    Last edited by dharani suresh; 2014-05-01 at 01:24.

  11. #8
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,202
    Thanks
    14
    Thanked 330 Times in 323 Posts
    You will have to make other modifications. I suspect your error is coming since you are no longer formatted as it expects it to be. You will have to fix that.

    At this point, it is a good time for you to learn to make those changes. I recommend stepping through the code and seeing what it is doing for your understanding. But in general, what you have changed requires:

    adding more col headers
    adjusting col numbers (dest and source) to match the new layout
    adding new items from the columns

    Some more specific instructions:
    1) the headers row need to be modified to match the new column layout. These need to be modified:
    wDest.Cells(1, 1) = .Cells(1, 1)
    wDest.Cells(1, 2) = "Interval"
    wDest.Cells(1, 3) = .Cells(1, 2)
    wDest.Cells(1, 4) = .Cells(1, 3)
    wDest.Cells(1, 5) = .Cells(1, 4)

    (dest1 is still source, but dest2 is source 2 and dest3 is the "Interval", then dest4 to the rest (need to add more) are 1 col less in the source). [Since you are adding many more, you could just copy the entire row from the source, then insert a new col 3 and make it interval instead of adding them all individually... If you are not sure how to do this, you might want to play with the macro recorder to see how it does this...]

    2) the code, the items filling in cols 1 & 2, need to be adapted to fill in 1,2,3 [dest1 will be same, dest2 will be new and similar to dest1, new dest3 should be similar to new dest2

    The old dest3 (timestamp) will be a new dest4

    The new columns in the dataset will need to be added after the locations adding old dest 4 &5.

    The comparison columns will also need to be adjusted. I needed to check the timestamp cols (old dest3, new dest4) at some points in the code and also checked the interval (old dest2, new dest3). The interval is based on old source col 3 which is now source col 4.

    Examining the code along with the old layout and new layout should help you figure out what numbers need to increased by 1 and where you need to add more items.

    Hope this helps,
    Steve

  12. The Following User Says Thank You to sdckapr For This Useful Post:

    dharani suresh (2014-05-01)

  13. #9
    Lounger
    Join Date
    Apr 2014
    Posts
    25
    Thanks
    19
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    You will have to make other modifications. I suspect your error is coming since you are no longer formatted as it expects it to be. You will have to fix that.

    Examining the code along with the old layout and new layout should help you figure out what numbers need to increased by 1 and where you need to add more items.

    Hope this helps,
    Steve
    Hello Steve,
    it was very nice to hear from you like this... you are not only helping me, you are also teaching me how to do this... this is really great and appreciable... thank you so much for your kindness....

    As you instructed me, i changed the values in the code according to my new extra cols excel sheet.
    the code is,
    Code:
    Option Explicit
    Sub ExtractData2()
      Dim wSource As Worksheet
      Dim wDest As Worksheet
      Dim lLastRow As Long
      Dim lRowSource As Long
      Dim lRowDest As Long
      Dim vArray As Variant
      Dim iInt As Integer
      Dim iIntPrev As Integer
      Dim i As Integer
      Dim bFilling As Boolean
    
      'Use this for 2 hours
      vArray = Array("0-2", "2-4", "4-6", "6-8", "8-10", "10-12", _
        "12-14", "14-16", "16-18", "18-20", "20-22", "22-24")
     
      Set wSource = ActiveSheet
      Set wDest = Worksheets.Add
      
      With wSource
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        wDest.Cells(1, 1) = .Cells(1, 1)
        wDest.Cells(1, 2) = .Cells(1, 2)
        wDest.Cells(1, 3) = "Interval"
        wDest.Cells(1, 4) = .Cells(1, 3)
       wDest.Cells(1, 5) = .Cells(1, 4)
    wDest.Cells(1, 6) = .Cells(1, 5)
    wDest.Cells(1, 7) = .Cells(1, 6)
    wDest.Cells(1, 8) = .Cells(1, 7)
    wDest.Cells(1, 9) = .Cells(1, 8)
    wDest.Cells(1, 10) = .Cells(1, 9)
    wDest.Cells(1, 11) = .Cells(1, 10)
    wDest.Cells(1, 12) = .Cells(1, 11)
    wDest.Cells(1, 13) = .Cells(1, 12)
        lRowSource = 3
        lRowDest = 3
        iIntPrev = -1
        i = LBound(vArray)
        bFilling = True
        Do Until lRowSource > lLastRow
        If lRowDest = 50000 Then
          MsgBox "here 50000"
          Exit Sub
        End If
          iInt = Int(.Cells(lRowSource, 4) * (UBound(vArray) - LBound(vArray) + 1))
          If .Cells(lRowSource, 3) = .Cells(lRowSource + 1, 3) _
            And i > iInt Then i = iInt
          If iIntPrev <> i _
            And wDest.Cells(lRowDest - 1, 4) <> wDest.Cells(lRowDest, 4) _
            Or Not (bFilling) Then
    
            wDest.Cells(lRowDest, 2) = .Cells(lRowSource, 2)
            wDest.Cells(lRowDest, 3) = "'" & vArray(i)
            iIntPrev = i
          End If
          wDest.Cells(lRowDest, 4) = .Cells(lRowSource, 3)
          If i >= iInt And bFilling Then
            wDest.Cells(lRowDest, 5) = .Cells(lRowSource, 4)
            wDest.Cells(lRowDest, 6) = .Cells(lRowSource, 5)
            lRowSource = lRowSource + 1
            i = iInt
          End If
          i = i + 1
          If i > UBound(vArray) Then
            i = LBound(vArray)
            If Not bFilling Then lRowSource = lRowSource + 1
            bFilling = True
          Else
            If wDest.Cells(lRowDest, 4) <> .Cells(lRowSource, 3) Then
              lRowSource = lRowSource - 1
              bFilling = False
            End If
          End If
          lRowDest = lRowDest + 1
        Loop
        .Range("c2:m2").Copy
        wDest.Range("d2:n" & lRowDest).PasteSpecial Paste:=xlPasteFormats
        wDest.Range("A:n").EntireColumn.AutoFit
      End With
      MsgBox "Done"
    End Sub
    half way i am through but half way i got stucked... half answer i m getting half answer i am not getting... which means it is eating all the extra cols what i added newly in the excel sheet, but not displaying the values, it is displaying only the headers...

    as you instructed me, i changed the time stamp col, time col interval col and at last i changed the cell ranges also...
    but still i am getting that...

    please you have to help me in this...
    I am so sorry i think i am disturbing you a lot... waiting for your positive reply...

    Thank you,

    With Kind Regards,
    Dharani.

  14. #10
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,202
    Thanks
    14
    Thanked 330 Times in 323 Posts
    You did not add lines include those columns...
    You have the lines:
    Code:
          If i >= iInt And bFilling Then
            wDest.Cells(lRowDest, 5) = .Cells(lRowSource, 4)
            wDest.Cells(lRowDest, 6) = .Cells(lRowSource, 5)
            lRowSource = lRowSource + 1
    Before the "lRowSource = lRowSource + 1" line you need to add the other lines for dest cols 7 - 13

    [you could use a loop if desired, since you have essentially identical lines, by creating a new integer variable and looping from dest 5 - 13 and grabbing 4-12, this could be done for the title as well]

    Steve

  15. The Following User Says Thank You to sdckapr For This Useful Post:

    dharani suresh (2014-05-01)

  16. #11
    Lounger
    Join Date
    Apr 2014
    Posts
    25
    Thanks
    19
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    You did not add lines include those columns...
    You have the lines:
    Code:
          If i >= iInt And bFilling Then
            wDest.Cells(lRowDest, 5) = .Cells(lRowSource, 4)
            wDest.Cells(lRowDest, 6) = .Cells(lRowSource, 5)
            lRowSource = lRowSource + 1
    Before the "lRowSource = lRowSource + 1" line you need to add the other lines for dest cols 7 - 13

    [you could use a loop if desired, since you have essentially identical lines, by creating a new integer variable and looping from dest 5 - 13 and grabbing 4-12, this could be done for the title as well]

    Steve
    Helloooo Steve,
    First of all, a big big thanks to you... you are really superb... hats off to your patience... you are so kind and nice, you taught me how to modify the codes depending upon my needs and you made me to do it...

    As you instructed me, i added these lines in the code like,
    Code:
          If i >= iInt And bFilling Then
            wDest.Cells(lRowDest, 5) = .Cells(lRowSource, 4)
            wDest.Cells(lRowDest, 6) = .Cells(lRowSource, 5)
    wDest.Cells(lRowDest, 7) = .Cells(lRowSource, 6)
    wDest.Cells(lRowDest, 8) = .Cells(lRowSource, 7)
    wDest.Cells(lRowDest, 9) = .Cells(lRowSource, 8)
    wDest.Cells(lRowDest, 10) = .Cells(lRowSource, 9)
    wDest.Cells(lRowDest, 11) = .Cells(lRowSource, 10)
    wDest.Cells(lRowDest, 12) = .Cells(lRowSource, 11)
    wDest.Cells(lRowDest, 13) = .Cells(lRowSource, 12)
    wDest.Cells(lRowDest, 14) = .Cells(lRowSource, 13)
    wDest.Cells(lRowDest, 15) = .Cells(lRowSource, 14)
    
            lRowSource = lRowSource + 1
            i = iInt
          End If
    now i am getting the 99% of my required output... with very small errors... i think i missed some where some values...
    in my output,
    i got the correct output. but i need some small corrections...
    1) first col values i am not getting, why?
    2) some disturbances are there, like 0-2 interval is missing in the first row only.
    3) values are starting from 2 row, its not eating the 1st row values... (see in input sheet...)
    4) at last i am not getting the wind header....

    apart from this small errors, the code is working perfectly, i hope...

    finally you made me to edit the code and made me to get the output... really you are great... because i was not confident on me in writing these codes..
    A millions bunch of thanks to you...

    Lastly, i request you to guide me how to rectify these small errors... i know its not a big deal at all...
    Eagerly waiting for your reply...
    for better understanding of what i am requesting you, please refer the attached excel sheet...

    Thank you so much...

    With Kind Regards,
    Dharani.
    Attached Files Attached Files
    Last edited by dharani suresh; 2014-05-01 at 23:03.

  17. #12
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,202
    Thanks
    14
    Thanked 330 Times in 323 Posts
    1) it misses the first source row since you changed the starting row to 3:
    lRowSource = 3

    The line should have remained:
    lRowSource = 2

    If you tell the code to start at 3, it will skip row 2....

    2) You are missing the first items (your problems 1-3) since you leave a blank row (you tell it to start at 3 rather than 2). to start in row 2 in the output you also need to change the line:
    lRowDest = 3
    back to:
    lRowDest = 2

    The blank row gave you problems at the beginning with the comparison (it is comparing the previous interval to not repeat the first 3 cols if the interval is the same) so did not print all the various initial ones correctly.

    3) [Your problem 4] You don't get the get the "Wind" title since you did not include it in the code. You need to add the line:

    wDest.Cells(1, 14) = .Cells(1, 13)

    right after the line:
    wDest.Cells(1, 13) = .Cells(1, 12)

    Steve

    PS
    You can delete the lines of code
    Code:
        If lRowDest = 50000 Then
          MsgBox "here 50000"
          Exit Sub
        End If
    That was part of "STOP" I added when I was debugging. Sometimes when the logic was messed up, it kept adding new lines in the destination but did not work through the source and never stopped. This was to prevent hanging the code. You no longer need it...
    Last edited by sdckapr; 2014-05-02 at 09:55.

  18. The Following User Says Thank You to sdckapr For This Useful Post:

    dharani suresh (2014-05-05)

  19. #13
    Lounger
    Join Date
    Apr 2014
    Posts
    25
    Thanks
    19
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    1) it misses the first source row since you changed the starting row to 3:
    lRowSource = 3

    That was part of "STOP" I added when I was debugging. Sometimes when the logic was messed up, it kept adding new lines in the destination but did not work through the source and never stopped. This was to prevent hanging the code. You no longer need it...
    Hello Steve,
    Thank you for your suggestions... i corrected all those mistakes... now its working 99% correctly.. i was able to rectify all my errors as per your guidance but except one...

    i am not getting the first col values in the output... i hope still i have to change the number some where in the code, but i was not able to find out that... so can you please tell me what shall i do now to get the first col values... ???

    Waiting for positive reply... please find the attachment for your easy understanding... because i must not waste your time... and also sorry for troubling you a lot... i hope you will not mind....

    Thank you,

    With Kind Regards,
    Dharani.
    Attached Files Attached Files

  20. #14
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,202
    Thanks
    14
    Thanked 330 Times in 323 Posts
    To extract the first Col and add the Interval, the original code had
    Code:
            wDest.Cells(lRowDest, 1) = .Cells(lRowSource, 1)
            wDest.Cells(lRowDest, 2) = "'" & vArray(i)
    This reads from the source col 1 and puts it into the dest col 1. then it puts the interval in dest col 2
    You changed those lines to:
    Code:
            wDest.Cells(lRowDest, 2) = .Cells(lRowSource, 2)
            wDest.Cells(lRowDest, 3) = "'" & vArray(i)
    This put the interval into col 3 of the dest as desired, and also reads from source col 2 to dest col 2. But you never added a line to read from the 1st column.
    It can go anywhere within that "if .. End if", I would just add it before the other 2:
    Code:
            wDest.Cells(lRowDest, 1) = .Cells(lRowSource, 1)
            wDest.Cells(lRowDest, 2) = .Cells(lRowSource, 2)
            wDest.Cells(lRowDest, 3) = "'" & vArray(i)
    Steve

  21. The Following User Says Thank You to sdckapr For This Useful Post:

    dharani suresh (2014-05-06)

  22. #15
    Lounger
    Join Date
    Apr 2014
    Posts
    25
    Thanks
    19
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    To extract the first Col and add the Interval, the original code had
    Code:
            wDest.Cells(lRowDest, 1) = .Cells(lRowSource, 1)
            wDest.Cells(lRowDest, 2) = "'" & vArray(i)
    wDest.Cells(lRowDest, 1) = .Cells(lRowSource, 1)
    wDest.Cells(lRowDest, 2) = .Cells(lRowSource, 2)
    wDest.Cells(lRowDest, 3) = "'" & vArray(i)[/code]

    Steve
    Hello Steve,

    Finally IT’S DONE!!!!!!!!!!!!!!!!!! I am getting my required output… Hurrahhh!!!!!
    Thank you so much Steve…. My Heartfelt Thanks to you…. Now I don’t have words to express my thankfulness and tribute to you… You are such a nice person… You are so kind and humble and having high level of patience…. Hats off to you…


    You guided me so nicely and patiently… I think I troubled you a lot by asking more and more questions but for everything you helped me… really a Big thanks to you Steve… YOU ARE A GREAT PERSON!!!! You made me to understand the code and taught me how it is working… now I think here after I must not disturb you for this thread again, since you have lots of work and other people also like me to whom you want help…

    It would be really great, if I can get your mail Id please, if it’s possible give me or else don’t want… and also can i know what is your profession???? i am really impressed with you...
    Can you please also tell me how you learned this technique of writing macros… after seeing you people in the forum, I am so eager to learn this and I also want to help others like you…

    Thank you Steve…. Thanks a lot… I hope always you will extend your support like this to me and also to others…

    With Kind Regards,
    Dharani.

    PS.,
    Steve, my last question please…
    In my output, in the first two cols namely trench and sector…

    I get few empty cells. If I want to fill it up with that trench numbers and sectors numbers what I have to do??? Why I am asking this question is like , I think you are the only person who can teach me about this VBA code … that’s y … if possible you answer or else no need.. because i must not trouble you a lot...Because in future I may need those empty cells to get filled up… which now I am doing manually…
    Last edited by dharani suresh; 2014-05-06 at 00:29.

Page 1 of 2 12 LastLast

Posting Permissions

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