I have an Column with excel cells with multiple values separated by " ," or " & " (coming from a DB). How do I control wordpad through excel VBA?
Sample data -
1111
1112,12311,2321,12312 & 23123
12321
1111
1115
1123, 12312
1211
1111,2321 & 2321
2321 & 1211
O/P required is without duplicates in 1 column unique values.
Till now I have been copying the data in a sheet ---> Remove dup. values ---> Text To Columns ---> 1.seperate by '&' 2. copy the values in the 2nd column , remove dup. and blanks ---> paste it below the original data --- > Text to Columns ---> separate by ',' ---> copy the data by each if greater than 1 --> transpose and pste below the original data.
I am currently trying to achieve here - > copy all original data --> remove dup -> paste in wordpad - > replace ',' and '&' by '^p' (this was suggested by my good friend and saves me a lot of time) and replace with original data.
I have reached till pasting the data in the Wordpad and do not know how to replace the data in the wordpad through excel VBA. Can anyone help me please ?
'Create and copying the required range to word
Dim iTotalRows As Integer ' GET TOTAL USED RANGE ROWS.
iTotalRows = Worksheets("Quote #").UsedRange.Rows.Count
Dim iTotalCols As Integer ' GET TOTAL COLUMNS.
iTotalCols = 2
' WORD OBJECT.
Dim oWord As Object
Set oWord = CreateObject(Class:="Word.Application")
oWord.Visible = True
oWord.Activate
' ADD A DOCUMENT TO THE WORD OBJECT.
Dim oDoc
Set oDoc = oWord.Documents.Add
' CREATE A RANGE FOR THE TABLE INSIDE WORD DOCUMENT.
Dim oRange
Set oRange = oDoc.Range
' CREATE AND DEFINE TABLE STRUCTURE USING
' THE ROWS AND COLUMNS EXTRACTED FROM EXCEL USED RANGE.
oDoc.Tables.Add oRange, iTotalRows, iTotalCols
' CREATE A TABLE OBJECT.
Dim oTable
Set oTable = oDoc.Tables(1)
'oTable.Borders.Enable = True
Dim iRows, iCols As Integer
' LOOP THROUGH EACH ROW AND COLUMN TO EXTRACT DATA IN EXCEL.
For iRows = 1 To iTotalRows
For iCols = 1 To iTotalCols
Dim txt As Variant
txt = Worksheets("Quote #").Cells(iRows, iCols)
oTable.cell(iRows, iCols).Range.Text = txt ' COPY (OR WRITE) DATA TO THE TABLE.
' BOLD HEADERS.
'If Val(iRows) = 1 Then
' objTable.cell(iRows, iCols).Range.Font.Bold = True
'End If
Next iCols
Next iRows
'to replace text code reference source pasted below
With oWord.ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ","
.Replacement.Text = "^p"
.wrap = 1 '.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'reference : -
End With
Set oWord = Nothing
I am trying to replace "," or "&" with "^p" which word will consider as a new line. Hope this helps.
O/P required : -
1112
12311
2321
12312
23123
12321
1111
1115
1123
1211
Ok, based on the comments and the post Word is not needed to remove the duplicates. I suggest to use a dictionary here. Sample code for the following situtation. The desired output to my understanding should be like in column C
The following code will do this
Option Explicit
Sub RemoveDuplicatesFromDBExtract()
Const COMMA = ","
Const AMPERSAND = "&"
Dim i As Long
Dim rg As Range
Dim sngCell As Range
Dim vDat As Variant
Dim vContent As Variant
' Add a reference to the Microsoft Scripting Runtime
' Select Tools->References from the Visual Basic menu.
' Check box beside "Microsoft Scripting Runtime" in the list.
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
' Adjust for your need
Set rg = Range("A1:A9")
For Each sngCell In rg
vContent = Replace(sngCell.Value, COMMA, vbCrLf)
vContent = Replace(vContent, AMPERSAND, vbCrLf)
vDat = Split(vContent, vbCrLf)
For i = LBound(vDat) To UBound(vDat)
On Error Resume Next
' If vdat(i) is already in the dictionary it will not be added twice
dict.Add Trim(vDat(i)), Trim(vDat(i))
On Error GoTo 0
Next i
Next sngCell
' Write output, adjust for your needs
Range("C1").Resize(dict.Count, 1) = WorksheetFunction.Transpose(dict.Items)
End Sub