Finding most common words in column WITHOUT specifying what words

E

echrist

New Member
Joined
Mar 5, 2013
Messages
4
Hey everyone. We're doing some restructuring of our programs at my organization, and I'm trying to make a list of what is considered most important to our clients based on their feedback. We enter their questionnaire responses into Excel regularly, but there are thousands of responses. I'm trying to make a list of what words appear most frequently without going through one by one and making a list of keywords.
Without keywords, I haven't been able to find anything on the subject. As an additional hurdle, the responses are written in sentence form (there will be ~10-15 words in each response).
For example:

I want to eat more pizza.
Make your program longer.
I wish we could eat more meals.

Obviously these are made up, but the hope is that "I," "eat," etc. are returned at the top of a list of most used words.
Is this possible?
Thanks in advance!
 
Sort by date Sort by votes
Here is another macro that you can try (I used the same setup as Akuini but I have no idea how it compares speedwise)...
Code: 
Sub WordFrequencies()
  Dim X As Long, Cnt As Long, Txt As String, Arr() As String
  Txt = " " & Join(Application.Transpose(Range([A1], Cells(Rows.Count, "A").End(xlUp)))) & " "
  For X = 2 To Len(Txt)
    If Mid(Txt, X, 1) = "'" And Not Mid(Txt, X - 1, 3) Like "[A-Za-z0-9]'[A-Za-z0-9]" Then
      Mid(Txt, X) = " "
    ElseIf Mid(Txt, X, 1) Like "[!A-Za-z0-9']" Then
      Mid(Txt, X) = " "
    End If
  Next
  Arr = Split(Application.Trim(Txt))
  With CreateObject("scripting.dictionary")
    For X = 0 To UBound(Arr)
      .Item(Arr(X)) = .Item(Arr(X)) + 1
    Next
    Cnt = .Count
    Range("D1").Resize(Cnt) = Application.Transpose(.Keys)
    Range("E1").Resize(Cnt) = Application.Transpose(.Items)
  End With
  Range("D1:E" & Cnt).Sort Range("E1"), xlDescending, Range("D1"), , xlAscending, Header:=xlNo, MatchCase:=False
End Sub
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
I forgot that Transpose function has a limit of 65536 item to process, so if the result (the unique words) is more than that, then the code will stop with error.
So this is the amended code to deal with that:

Code: 
[FONT=Lucida Console][COLOR=Royalblue]Sub[/COLOR] regexWordFrequency()
[I][COLOR=Dimgray]'word frequency[/COLOR][/I]
[I][COLOR=Dimgray]'Put the data in col A, run the code, the result is in col D:E.[/COLOR][/I]
[I][COLOR=Dimgray]'tested on a text (from a novel) with 161K words, it took 1.2 seconds[/COLOR][/I]

[COLOR=Royalblue]Dim[/COLOR] regEx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR], matches [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR], x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR], d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] obj [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]New[/COLOR] DataObject
[COLOR=Royalblue]Dim[/COLOR] tx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR], z [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] t, q, va
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]

t = Timer
Range([COLOR=Darkcyan]"A1"[/COLOR], Cells(Rows.count, [COLOR=Darkcyan]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp)).Copy
obj.GetFromClipboard
tx = obj.GetText
Application.CutCopyMode = False
tx = Replace(tx, [COLOR=Darkcyan]"'"[/COLOR], [COLOR=Darkcyan]"___"[/COLOR])
    
        [COLOR=Royalblue]Set[/COLOR] regEx = CreateObject([COLOR=Darkcyan]"VBScript.RegExp"[/COLOR])
        [COLOR=Royalblue]With[/COLOR] regEx
            .[COLOR=Royalblue]Global[/COLOR] = True
            .MultiLine = True
            .IgnoreCase = True
            .pattern = [COLOR=Darkcyan]"\w+"[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

    [COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=Darkcyan]"scripting.dictionary"[/COLOR])
    d.CompareMode = vbTextCompare
        
            [COLOR=Royalblue]Set[/COLOR] matches = regEx.Execute(tx)
            
            [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x In matches
                d([COLOR=Royalblue]CStr[/COLOR](x)) = d([COLOR=Royalblue]CStr[/COLOR](x)) + [COLOR=Brown]1[/COLOR]
            [COLOR=Royalblue]Next[/COLOR]
                
[COLOR=Royalblue]If[/COLOR] d.count = [COLOR=Brown]0[/COLOR] [COLOR=Royalblue]Then[/COLOR] MsgBox [COLOR=Darkcyan]"[COLOR=Royalblue]Nothing[/COLOR] found"[/COLOR]: [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]Sub[/COLOR]

[I][COLOR=Dimgray]'put the result in col D:E[/COLOR][/I]
Range([COLOR=Darkcyan]"D:E"[/COLOR]).ClearContents
[COLOR=Royalblue]With[/COLOR] Range([COLOR=Darkcyan]"D2"[/COLOR]).Resize(d.count, [COLOR=Brown]2[/COLOR])
    [COLOR=Royalblue]If[/COLOR] d.count < [COLOR=Brown]65536[/COLOR] [COLOR=Royalblue]Then[/COLOR] [I][COLOR=Dimgray]'Transpose function has a limit of 65536 item to process[/COLOR][/I]
        
        .Value = Application.Transpose(Array(d.Keys, d.items))
        
    [COLOR=Royalblue]Else[/COLOR]
        
        [COLOR=Royalblue]ReDim[/COLOR] va([COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] d.count, [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=Brown]2[/COLOR])
        i = [COLOR=Brown]0[/COLOR]
            [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] q In d.Keys
                i = i + [COLOR=Brown]1[/COLOR]
                va(i, [COLOR=Brown]1[/COLOR]) = q: va(i, [COLOR=Brown]2[/COLOR]) = d(q)
            [COLOR=Royalblue]Next[/COLOR]
        .Value = va
        
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    .Replace what:=[COLOR=Darkcyan]"___"[/COLOR], Replacement:=[COLOR=Darkcyan]"'"[/COLOR], LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
    .Sort Key1:=.Cells([COLOR=Brown]1[/COLOR], [COLOR=Brown]2[/COLOR]), Order1:=xlDescending, Key2:=.Cells([COLOR=Brown]1[/COLOR], [COLOR=Brown]1[/COLOR]), Order2:=xlAscending, Header:=xlNo
    
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

Range([COLOR=Darkcyan]"D1"[/COLOR]) = [COLOR=Darkcyan]"WORD"[/COLOR]
Range([COLOR=Darkcyan]"E1"[/COLOR]) = [COLOR=Darkcyan]"FREQUENCY"[/COLOR]
Range([COLOR=Darkcyan]"D:E"[/COLOR]).Columns.AutoFit

Debug.Print Timer - t
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Upvote 0
Hi, Rick, I tested your code on text with 2000 words & it worked, but with 5300 words it stopped at this line:
Arr = Split(Application.Trim(Txt))

maybe Application.Trim has limit on how many words to process?
 
Upvote 0
Akuini said:
Hi, Rick, I tested your code on text with 2000 words & it worked, but with 5300 words it stopped at this line:
Arr = Split(Application.Trim(Txt))

maybe Application.Trim has limit on how many words to process?
Click to expand...
Akuini said:
I forgot that Transpose function has a limit of 65536 item to process, so if the result (the unique words) is more than that, then the code will stop with error.
So this is the amended code to deal with that:

Code: 
[FONT=Lucida Console][COLOR=Royalblue]Sub[/COLOR] regexWordFrequency()
[I][COLOR=Dimgray]'word frequency
'Put the data in col A, run the code, the result is in col D:E.
'tested on a text (from a novel) with 161K words, it took 1.2 seconds[/COLOR][/I]

[COLOR=Royalblue]Dim[/COLOR] regEx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR], matches [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR], x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR], d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object
Dim[/COLOR] obj [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]New[/COLOR] DataObject
[COLOR=Royalblue]Dim[/COLOR] tx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR], z [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String
Dim[/COLOR] t, q, va
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]

t = Timer
Range([COLOR=Darkcyan]"A1"[/COLOR], Cells(Rows.count, [COLOR=Darkcyan]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp)).Copy
obj.GetFromClipboard
tx = obj.GetText
Application.CutCopyMode = False
tx = Replace(tx, [COLOR=Darkcyan]"'"[/COLOR], [COLOR=Darkcyan]"___"[/COLOR])
   
        [COLOR=Royalblue]Set[/COLOR] regEx = CreateObject([COLOR=Darkcyan]"VBScript.RegExp"[/COLOR])
        [COLOR=Royalblue]With[/COLOR] regEx
            .[COLOR=Royalblue]Global[/COLOR] = True
            .MultiLine = True
            .IgnoreCase = True
            .pattern = [COLOR=Darkcyan]"\w+"[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

    [COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=Darkcyan]"scripting.dictionary"[/COLOR])
    d.CompareMode = vbTextCompare
       
            [COLOR=Royalblue]Set[/COLOR] matches = regEx.Execute(tx)
           
            [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x In matches
                d([COLOR=Royalblue]CStr[/COLOR](x)) = d([COLOR=Royalblue]CStr[/COLOR](x)) + [COLOR=Brown]1[/COLOR]
            [COLOR=Royalblue]Next[/COLOR]
               
[COLOR=Royalblue]If[/COLOR] d.count = [COLOR=Brown]0[/COLOR] [COLOR=Royalblue]Then[/COLOR] MsgBox [COLOR=Darkcyan]"[COLOR=Royalblue]Nothing[/COLOR] found"[/COLOR]: [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]Sub[/COLOR]

[I][COLOR=Dimgray]'put the result in col D:E[/COLOR][/I]
Range([COLOR=Darkcyan]"D:E"[/COLOR]).ClearContents
[COLOR=Royalblue]With[/COLOR] Range([COLOR=Darkcyan]"D2"[/COLOR]).Resize(d.count, [COLOR=Brown]2[/COLOR])
    [COLOR=Royalblue]If[/COLOR] d.count < [COLOR=Brown]65536[/COLOR] [COLOR=Royalblue]Then[/COLOR] [I][COLOR=Dimgray]'Transpose function has a limit of 65536 item to process[/COLOR][/I]
       
        .Value = Application.Transpose(Array(d.Keys, d.items))
       
    [COLOR=Royalblue]Else[/COLOR]
       
        [COLOR=Royalblue]ReDim[/COLOR] va([COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] d.count, [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=Brown]2[/COLOR])
        i = [COLOR=Brown]0[/COLOR]
            [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] q In d.Keys
                i = i + [COLOR=Brown]1[/COLOR]
                va(i, [COLOR=Brown]1[/COLOR]) = q: va(i, [COLOR=Brown]2[/COLOR]) = d(q)
            [COLOR=Royalblue]Next[/COLOR]
        .Value = va
       
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    .Replace what:=[COLOR=Darkcyan]"___"[/COLOR], Replacement:=[COLOR=Darkcyan]"'"[/COLOR], LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
    .Sort Key1:=.Cells([COLOR=Brown]1[/COLOR], [COLOR=Brown]2[/COLOR]), Order1:=xlDescending, Key2:=.Cells([COLOR=Brown]1[/COLOR], [COLOR=Brown]1[/COLOR]), Order2:=xlAscending, Header:=xlNo
   
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

Range([COLOR=Darkcyan]"D1"[/COLOR]) = [COLOR=Darkcyan]"WORD"[/COLOR]
Range([COLOR=Darkcyan]"E1"[/COLOR]) = [COLOR=Darkcyan]"FREQUENCY"[/COLOR]
Range([COLOR=Darkcyan]"D:E"[/COLOR]).Columns.AutoFit

Debug.Print Timer - t
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
Click to expand...


Hello Akuini,
Your help over here is divine. My problem is similar but the formatting is different. Would you be able to assist?
I need date in 5 columns like this, and i want top 3 most common words from those 5 columns like this OUTPUT 1, OUTPUT 2 and OUTPUT 3.
Is it possible?
Capture.JPG
 
Upvote 0
mtahreemalam said:
I need date in 5 columns like this, and i want top 3 most common words from those 5 columns like this OUTPUT 1, OUTPUT 2 and OUTPUT 3.
Click to expand...
Do you only have 1 row of data (i.e range A2:E2)?
 
Upvote 0
First of all, because of the the new forum style, my code in post #12 become messy. So this is the code in post #12 in case anyone needs it:

VBA Code: 
Sub regexWordFrequency()
'word frequency
'Put the data in col A, run the code, the result is in col D:E.
'tested on a text (from a novel) with 161K words, it took 1.2 seconds

Dim regEx As Object, matches As Object, x As Object, d As Object
Dim obj As New DataObject
Dim tx As String, z As String
Dim t, q, va
Dim i As Long

t = Timer
Range("A1", Cells(Rows.Count, "A").End(xlUp)).Copy
obj.GetFromClipboard
tx = obj.GetText
Application.CutCopyMode = False
tx = Replace(tx, "'", "___")
    
        Set regEx = CreateObject("VBScript.RegExp")
        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .pattern = "\w+"
        End With

    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
        
            Set matches = regEx.Execute(tx)
            
            For Each x In matches
                d(CStr(x)) = d(CStr(x)) + 1
            Next
                
If d.Count = 0 Then MsgBox "Nothing found": Exit Sub

'put the result in col D:E
Range("D:E").ClearContents
With Range("D2").Resize(d.Count, 2)
    If d.Count < 65536 Then 'Transpose function has a limit of 65536 item to process
        
        .Value = Application.Transpose(Array(d.Keys, d.items))
        
    Else
        
        ReDim va(1 To d.Count, 1 To 2)
        i = 0
            For Each q In d.Keys
                i = i + 1
                va(i, 1) = q: va(i, 2) = d(q)
            Next
        .Value = va
        
    End If
    .Replace What:="___", Replacement:="'", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
    .Sort Key1:=.Cells(1, 2), Order1:=xlDescending, Key2:=.Cells(1, 1), Order2:=xlAscending, Header:=xlNo
    
End With

Range("D1") = "WORD"
Range("E1") = "FREQUENCY"
Range("D:E").Columns.AutoFit

Debug.Print Timer - t
End Sub

mtahreemalam said:
No. Approx 10,000
Click to expand...
Ok, try this:

VBA Code: 
Sub a726216_WordFrequency()
'word frequency

Dim regEx As Object, matches As Object, x As Object, d As Object
Dim obj As New DataObject
Dim tx As String, z As String
Dim t, q, va
Dim i As Long

Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
obj.GetFromClipboard
tx = obj.GetText
Application.CutCopyMode = False
tx = Replace(tx, "'", "___")
    
        Set regEx = CreateObject("VBScript.RegExp")
        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .pattern = "\w+"
        End With

    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
        
            Set matches = regEx.Execute(tx)
            
            For Each x In matches
                d(CStr(x)) = d(CStr(x)) + 1
            Next
                
If d.Count = 0 Then MsgBox "Nothing found": Exit Sub

'put the result in col M:N
Range("M:N").ClearContents
With Range("M1").Resize(d.Count, 2)
    If d.Count < 65536 Then 'Transpose function has a limit of 65536 item to process
        
        .Value = Application.Transpose(Array(d.Keys, d.items))
        
    Else
        
        ReDim va(1 To d.Count, 1 To 2)
        i = 0
            For Each q In d.Keys
                i = i + 1
                va(i, 1) = q: va(i, 2) = d(q)
            Next
        .Value = va
        
    End If
    .Replace What:="___", Replacement:="'", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
    .Sort Key1:=.Cells(1, 2), Order1:=xlDescending, Key2:=.Cells(1, 1), Order2:=xlAscending, Header:=xlNo
    
End With

Range("G2:I2") = Application.Transpose(Range("M1:M3"))
Range("M:N").ClearContents

End Sub

Note:
1. I assumed data is in col A:E, starting at row 2.
2. The result is in "G2:I2"
3. Column M:N are temporary helper column.
 
Upvote 0
Akuini said:
First of all, because of the the new forum style, my code in post #12 become messy. So this is the code in post #12 in case anyone needs it:

VBA Code: 
Sub regexWordFrequency()
'word frequency
'Put the data in col A, run the code, the result is in col D:E.
'tested on a text (from a novel) with 161K words, it took 1.2 seconds

Dim regEx As Object, matches As Object, x As Object, d As Object
Dim obj As New DataObject
Dim tx As String, z As String
Dim t, q, va
Dim i As Long

t = Timer
Range("A1", Cells(Rows.Count, "A").End(xlUp)).Copy
obj.GetFromClipboard
tx = obj.GetText
Application.CutCopyMode = False
tx = Replace(tx, "'", "___")
   
        Set regEx = CreateObject("VBScript.RegExp")
        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .pattern = "\w+"
        End With

    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
       
            Set matches = regEx.Execute(tx)
           
            For Each x In matches
                d(CStr(x)) = d(CStr(x)) + 1
            Next
               
If d.Count = 0 Then MsgBox "Nothing found": Exit Sub

'put the result in col D:E
Range("D:E").ClearContents
With Range("D2").Resize(d.Count, 2)
    If d.Count < 65536 Then 'Transpose function has a limit of 65536 item to process
       
        .Value = Application.Transpose(Array(d.Keys, d.items))
       
    Else
       
        ReDim va(1 To d.Count, 1 To 2)
        i = 0
            For Each q In d.Keys
                i = i + 1
                va(i, 1) = q: va(i, 2) = d(q)
            Next
        .Value = va
       
    End If
    .Replace What:="___", Replacement:="'", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
    .Sort Key1:=.Cells(1, 2), Order1:=xlDescending, Key2:=.Cells(1, 1), Order2:=xlAscending, Header:=xlNo
   
End With

Range("D1") = "WORD"
Range("E1") = "FREQUENCY"
Range("D:E").Columns.AutoFit

Debug.Print Timer - t
End Sub


Ok, try this:

VBA Code: 
Sub a726216_WordFrequency()
'word frequency

Dim regEx As Object, matches As Object, x As Object, d As Object
Dim obj As New DataObject
Dim tx As String, z As String
Dim t, q, va
Dim i As Long

Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
obj.GetFromClipboard
tx = obj.GetText
Application.CutCopyMode = False
tx = Replace(tx, "'", "___")
   
        Set regEx = CreateObject("VBScript.RegExp")
        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .pattern = "\w+"
        End With

    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
       
            Set matches = regEx.Execute(tx)
           
            For Each x In matches
                d(CStr(x)) = d(CStr(x)) + 1
            Next
               
If d.Count = 0 Then MsgBox "Nothing found": Exit Sub

'put the result in col M:N
Range("M:N").ClearContents
With Range("M1").Resize(d.Count, 2)
    If d.Count < 65536 Then 'Transpose function has a limit of 65536 item to process
       
        .Value = Application.Transpose(Array(d.Keys, d.items))
       
    Else
       
        ReDim va(1 To d.Count, 1 To 2)
        i = 0
            For Each q In d.Keys
                i = i + 1
                va(i, 1) = q: va(i, 2) = d(q)
            Next
        .Value = va
       
    End If
    .Replace What:="___", Replacement:="'", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
    .Sort Key1:=.Cells(1, 2), Order1:=xlDescending, Key2:=.Cells(1, 1), Order2:=xlAscending, Header:=xlNo
   
End With

Range("G2:I2") = Application.Transpose(Range("M1:M3"))
Range("M:N").ClearContents

End Sub

Note:
1. I assumed data is in col A:E, starting at row 2.
2. The result is in "G2:I2"
3. Column M:N are temporary helper column.
Click to expand...

Hey thankyou so much.
Just a short glich. i am getting this error
 

Attachments

  • Capture1.JPG
    Capture1.JPG
    27.2 KB · Views: 150
Upvote 0
I said this in post #10:
Note: You need to add the reference “Microsoft Forms 2.0 Object Library” (to work with clipboard)
And this is how:
1. Open your VBA editor.
2. Click Tools > References.
3. Check the box next to “Microsoft Forms 2.0 Object Library.”
 
Upvote 0
Hey thankyou so much its working perfect.
One more question, can i drag this code to other cells for the data of 10,000
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
VBA/Macros help for an Excel to Word document generator. Need to create and find/replace X tables, where X is the numberof rows TRUE in another sheet
2
Replies
10
Views
2K
NdNoviceHlp
NdNoviceHlp
A
  • Question
First VBA Project - is there a better way to write this code?
Replies
0
Views
2K
akshay27
A
L
  • Solved
Ranking similarity between multiple fields
Replies
4
Views
401
Lurkily
L
R
  • Question
When cell in column contains value, select cell on the right, copy and paste in cell on right again
Replies
3
Views
697
Fluff
Fluff
Oakie_Uffda
  • Question
Split Cell into multiple without splitting words and print decent
Replies
1
Views
1K
Oakie_Uffda
Oakie_Uffda

Forum statistics

Threads
1,214,922
Messages
6,122,281
Members
449,075
Latest member
staticfluids

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top