Home Vba separate multiple dates in one cell
Reply: 0

Vba separate multiple dates in one cell

user1807
1#
user1807 Published in July 18, 2018, 4:50 am

I am trying to separate multiple dates from one cell into multiple cells containing one date in a transposed area and then paste them back over the original area as separate entries.

An example cell might have dates stored like 10/1110/1110/13 or 10/310/310/410/5. The second scenario is what is causing the error as there is no leading zero for single digit days like 10/3, for example.

Ideally, the code would separate the dates into separate cells like: 10/11,10/11,10/13 and 10/3,10/4,10/5. When single digits days are present ,however, it comes out completely jumbled up and inaccurate.

Admittedly, I had help from another coworker with this code who is on vacation currently, which is why I am having such trouble understanding this. Is there something I could change to account for single digit days or should I approach this process differently?

Thanks!

'separate column J by "/" and store in transpose area

  dim h as variant
  dim i as variant
  dim j as variant
  dim counter as variant
  dim stringcheck as variant
  dim strInput as variant
  dim strCurrent as variant



 strInput = Cells(j, 10)
 h = 0

For counter = 1 To Len(strInput) - 2
    stringcheck = InStr(strInput, "/")
    Debug.Print j & stringcheck
    If stringcheck <> 0 Then


        If Mid(strInput, counter, 1) = "/" Then
            Cells(17, i + h) = strCurrent & Mid(strInput, counter, 3)
            counter = counter + 2
            h = h + 1
            strCurrent = vbNullString
        Else
            Cells(17, i + h) = Cells(j, 10)
            strCurrent = strCurrent & Mid(strInput, counter, 1)

        End If

    'else just paste the value
    Else
        Cells(17, i) = strInput
    End If

Next counter
You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.316518 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO