PDA

View Full Version : [SOLVED] Removing web address references / placing ... on a cell after 397 characters.



DiamondNate
02-19-2014, 11:42 AM
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
02-20-2014, 03:34 AM
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
02-20-2014, 06:40 AM
Thanks Westconn1!

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

westconn1
02-21-2014, 01:48 AM
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
02-21-2014, 07:16 AM
Still doesn't run with the rws in there. Also stops at the same spot, nd = InStr(pos, mystr, " ")

westconn1
02-21-2014, 01:56 PM
Still doesn't run with the rws in therechange 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
02-21-2014, 02:09 PM
Works like a champ! Thank you so much!! :)