I'm creating a new process in Excel that ties in several spreadsheets. One of my current problems is in porting notes over to the new spreadsheet. The issue arises with the system that the data is stored in. Every time someone edits a note in the system it generates a Unique LineRefNo. This creates an issue as I will have an address that has 20 lines of data. Each line has the same note but several unique LineRefNo scattered throughout. This makes it impossible to port over clean notes on an aggregate level.
I've tried some base code and different variations just to remove the current LineRefNum currently. I have been overdeleting with that code however.
' This Macro is to remove excess information from the Comment Field
ActiveWorkbook.ActiveSheet.Range("A1").Select
ActiveWorkbook.ActiveSheet.Cells.Replace What:="{[LineRefNum", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
I've got two issues. One is the base code I've started with is deleting all data from almost every cell. I just want it to remove the LineRefNo and leave the actual note.
The second issue is I need it to delete the LineRefNo plus the 16 characters following this phrase. ({[LineRefNum: 532351517A000010]).
The end result would be just the actual comment that follows. {[LineRefNum: 532354632A000010][Comment: Cleared and approved on PV 2.13.19 File ][User: \\*****][Date: Feb 27 2019 11:08AM]}
If I can get that to work I would edit and expand upon the Macro to do more cleanup functions on the text.
Thanks for any help. If this is impossible in VBA currently just let me know and I will stop wasting my time.
EDIT : Realized you can still use the Range.Replace method to do this in one fell swoop since your match condition is pretty simple:
Sub tgr()
ActiveWorkbook.ActiveSheet.Cells.Replace "[LineRefNum*]", vbNullString
End Sub
(Original post, leaving for posterity and anybody interested in learning regex) Here's an example of how to accomplish this using a regular expression:
Sub tgr()
Dim ws As Worksheet
Dim rData As Range
Dim oRegEx As Object
Dim oMatches As Object
Dim vMatch As Variant
Dim aData As Variant
Dim sCommentsCol As String
Dim sPattern As String
Dim lHeaderRow As Long
Dim i As Long
Set ws = ActiveWorkbook.ActiveSheet
sPattern = "\[LineRefNum:\s[(a-z|A-Z|0-9)]+\]"
sCommentsCol = "A"
lHeaderRow = 1 'If you don't have a header row, set this to 0
Set oRegEx = CreateObject("VBScript.RegExp")
With oRegEx
.MultiLine = True
.Global = True
.IgnoreCase = True
.Pattern = sPattern
End With
With ws.Range(ws.Cells(lHeaderRow + 1, sCommentsCol), ws.Cells(ws.Rows.Count, sCommentsCol).End(xlUp))
If .Row <= lHeaderRow Then Exit Sub 'No data
Set rData = .Cells
If .Cells.Count = 1 Then
ReDim aData(1 To 1, 1 To 1)
aData(1, 1) = .Value
Else
aData = .Value
End If
End With
For i = 1 To UBound(aData, 1)
Set oMatches = oRegEx.Execute(aData(i, 1))
If oMatches.Count > 0 Then
For Each vMatch In oMatches
aData(i, 1) = Replace(aData(i, 1), vMatch, vbNullString)
Next vMatch
End If
Next i
rData.Value = aData
End Sub
This did what you wanted in testing, could always use more information but it seems you know what column this text edit needs to take place in:
Option Explicit
Public Sub parserLineRef()
Dim lastrow As Long
Dim startrow As Long
Dim searchcol As Long ' col number definition
Dim i As Long 'loop iterator
Dim newstring As String 'the newly modified string
Dim oldstring As String 'the original string
Dim retPos As Long 'the position of the substring in the serached string, zero is not found
Dim ws As Worksheet
'Change this to suit your needs
searchcol = 1
startrow = 1
'Change this to suit your needs
Set ws = ThisWorkbook.Worksheets("Sheet1") 'I simply copied into a new workbook default name is Sheet1
'get the last row
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = startrow To lastrow
'convert cell contents to string, just in case
oldstring = CStr(ws.Cells(i, searchcol))
'Find the position of the string in the cell
'zero means your search string is not found
retPos = InStr(oldstring, "[LineRefNum")
If retPos > 0 Then
'the substring was found, make a new string taking the LineRefNum off
newstring = Mid(oldstring, retPos + 30, Len(oldstring) - (retPos + 30))
'put the new string back into the cell
ws.Cells(i, searchcol) = newstring
Else
'Do Nothing, move along to the next row
End If
Next i
End Sub
Give it a spin and see if it meets your needs.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.