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!! :)
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.