Results 1 to 2 of 2

Thread: loops issue

  1. #1

    Thread Starter
    New Member ArielZusya's Avatar
    Join Date
    Jan 2008
    Location
    Denver, CO
    Posts
    2

    loops issue

    Hi Folks,

    I've got a spreadsheet with roughly 2000 lines of data. It's not entered in a useful way and I'm trying to clean up the data to make it more useful. Specifically, in one column, there is two data types (an alpha-numeric reference code and a date with day, date, month and year) and I'd like to move the two types into their own columns. An example of the two types are:

    Monday, January 4, 2010

    and

    07 DS 1234

    Whenever the date appears in that column (column D) nothing else appears in that row. I figured I would write a loop that would find the dates and move them into column A (which is empty), but I've never done that before so I'm not sure entirely how to do it. Here's where I am so far:

    Code:
    Sub DayDateMover ()
        Const strToFind As String = "Monday, "
        Dim rngDateOrigin As Range
        Dim rngDateDest As Range
        Dim strFirstAddress As String
        
        Application.ScreenUpdating = False
        
        With Sheet1.Range("D:D")
            Set rngDateOrigin = .Find( _
                                What:=strToFind, _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)
            
            If Not rngDateOrigin Is Nothing Then
                
                strFirstAddress = rngFound.Address
                Set rngDateOrigin = .FindNext(after:=rngDateOrigin)
                
                Do Until rngDateOrigin.Address = strFirstAddress
                    Set rngDateDest = Cells(rngDateOrigin.Row, Columns("a").Column)
                    rngDateOrigin.Cut Destination:=rngDateDest
                    Set rngDateOrigin = .FindNext(after:=rngdateOrigin)
                Loop
                
            End If
        End With
        
        Application.ScreenUpdating = True
    End Sub
    As those of you who know what you're doing have probably already figured out, that doesn't work. My thought was I would find the first instance of the date in column D, store it in a variable (rngDateOrigin) to be used for the iterations and it's address to a separate variable (strFirstAddress) to keep track of where I started in the column, then set rngDateOrigin to the next occurance of the date I'm looking for, set the destination cell address to a variable based on the address of the latest origin (rngDateDest) and then cut the value from the origin, past in the dest, and set rngDateOrigin to the next occurrence of the date. Everything works for me until I try to advance to the next occurrence of the date.

    Any suggestions on how I might be able to fix this? (BTW, I'm doing this one at a time for the five days of the week but if there's an easier way to do that I'd be happy to do that as well.) Thanks in advance for your assistance!

    Ariel

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: loops issue

    you can try this
    vb Code:
    1. For Each c In Range("d:d")
    2. ' If IsEmpty(c) Then Exit For  ' stop on empty cell
    3.  If IsDate(c) Then
    4.     c.Offset(, -3).NumberFormat = "dd/mm/yyyy"   ' change format to suit, or format entire column A first
    5.     c.Offset(, -3) = c
    6.      c.Value = ""
    7.   End If
    8. Next
    Last edited by westconn1; Dec 22nd, 2009 at 04:28 PM.
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

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



Click Here to Expand Forum to Full Width