Removing web address references / placing ... on a cell after 397 characters.

[DiamondNate]

Hello.

I have the attached excel file that I have been struggling with and looking for help on writing a macro to solve some formatting issues so the file can be uploaded.

Here are the things I am trying to accomplish
1) rows A2,A8,A14,A20... I need to remove everything after the date. So starting at T to Z (including T and Z)
2) rows A4,A10,A16,A22.... I need to do several formatting things too.
a. Need to replace ' and ' with ' & '
b. Remove any reference to a web address
c. Lastly after a & b have been completed any cell with more than 400 characters needs to be cut off at 397 characters and place a '...' at the end.

If anyone can help me it would greatly be appreciated. I'm stumped. I know basic macros but this is out of my league.

[westconn1]

you can test this

rws = Array("2", "8", "14", "20")
For rw = 0 To UBound(rws)
    Range("a" & rws(rw)).Value = Format(Left(Range("a" & rws(rw)), InStr(Range("a" & rws(rw)), "T") - 1), "yyyy-mm-dd")
    Range("a" & rws(rw)).NumberFormat = "yyyy-mm-dd"
Next
rws = Array("4", "10", "16", "22")
For rw = 0 To UBound(rws)
    Range("a" & rws(rw)).Replace " and ", " & "
    If InStr(Range("a" & rws(rw)), "http") > 0 Then
        mystr = Range("a" & rws(rw))
        pos = InStr(mystr, "http")
        Do
            nd = InStr(pos, mystr, " ")
            If nd = 0 Then nd = Len(mystr)
            webadd = Mid(mystr, pos, nd - pos)
            If Right(webadd, 1) = "." Then webadd = Left(webadd, Len(webadd) - 1)
            mystr = Replace(mystr, webadd, vbNullString)
            pos = InStr(mystr, "http")
        Loop Until pos = 0
        If Len(mystr) > 400 Then mystr = Left(mystr, 397) & "..."
        Range("a" & rws(rw)).Value = mystr
    End If
Next

[DiamondNate]

Thanks Westconn1!

This worked great. Quick question if the array's continue on how do I change this to include the whole worksheet?

[westconn1]

you could use a for next loop with a step of 6
try like

lastrow = cells(rows.count, 1).end(xlup).row
for rw = 2 to   lastrow step 6
    Range("a" & rw).Value = Format(Left(Range("a" & rws(rw)), InStr(Range("a" & rws(rw)), "T") - 1), "yyyy-mm-dd")
    Range("a" & rw).NumberFormat = "yyyy-mm-dd"

    Range("a" & rw + 2).Replace " and ", " & "
        mystr = Range("a" & rw + 2)
        pos = InStr(mystr, "http")
        Do
            nd = InStr(pos, mystr, " ")
            If nd = 0 Then nd = Len(mystr)
            webadd = Mid(mystr, pos, nd - pos)
            If Right(webadd, 1) = "." Then webadd = Left(webadd, Len(webadd) - 1)
            mystr = Replace(mystr, webadd, vbNullString)
            pos = InStr(mystr, "http")
        Loop Until pos = 0
        If Len(mystr) > 400 Then mystr = Left(mystr, 397) & "..."
        Range("a" & rw + 2).Value = mystr
next

[DiamondNate]

Still doesn't run with the rws in there. Also stops at the same spot, nd = InStr(pos, mystr, " ")

[westconn1]

Still doesn't run with the rws in there

change this line, i missed the last 2

Range("a" & rw).Value = Format(Left(Range("a" & rw), InStr(Range("a" & rw), "T") - 1), "yyyy-mm-dd")

here is a tested version (runs without error on the sample workbook, but results not checked

lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For rw = 2 To lastrow Step 6
    pos = InStr(Range("a" & rw), "T")
    If Not pos = 0 Then Range("a" & rw).Value = Format(Left(Range("a" & rw), pos - 1), "yyyy-mm-dd")
    Range("a" & rw).NumberFormat = "yyyy-mm-dd"
     
    mystr = Range("a" & rw + 2)
    mystr = Replace(mystr, " and ", " & ")
    pos = InStr(mystr, "http")
    
    Do While pos > 0
        nd = InStr(pos, mystr, " ")
        If nd = 0 Then nd = Len(mystr)
        webadd = Mid(mystr, pos, nd - pos)
        If Right(webadd, 1) = "." Then webadd = Left(webadd, Len(webadd) - 1)
        mystr = Replace(mystr, webadd, vbNullString)
        pos = InStr(mystr, "http")
    Loop
    
    If Len(mystr) > 400 Then mystr = Left(mystr, 397) & "..."
    Range("a" & rw + 2).Value = mystr
Next

[DiamondNate]

Works like a champ! Thank you so much!!