excelvbawordpad

Control wordpad through excel VBA


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


Solution

  • 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

    enter image description here

    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