Have been looking for a while and can't find a solution. I am trying to find a way to consolidate the first letter in single cells using a formula/vba. I am new to excel and vba but slowly learning.

My data looks like this:


Data is a single column (A:A) like below. I want a way to consolidate the letters in the single cells and output the result (B:B)

I want the output to look like this:


I have spent the past 2 days trying to figure this out. I have tried multiple solutions but none seem to work for me.

The closest I was able to get was using the following function:

Function RemoveDupes1(pWorkRng As Range) As String
Dim xValue As String
Dim xChar As String
Dim xOutValue As String
Set xDic = CreateObject("Scripting.Dictionary")
xValue = pWorkRng.Value
For i = 1 To VBA.Len(xValue)
    xChar = VBA.Mid(xValue, i, 1)
    If xDic.Exists(xChar) Then
        xDic(xChar) = ""
        xOutValue = xOutValue & xChar
    End If
RemoveDupes1 = xOutValue
End Function

However, not all the results are desired:


As you can see, if there is a double number, it is removed.


1 Answer 1


Disclaimer: I arrived at this answer using ChatGPT.

I did not see a notice for ChatGPT being banned on Super User, but I am aware it is banned on Stack Overflow and is being discussed heavily on Meta for multiple sites. Mods feel free to delete if it does not meet the policies of Super User.


I thought this would be a fun exercise to experiment with ChatGPT since I am only a beginner at VBA.

I first tried multiple iterations of having it fix the function you got closest to your desired behavior. It was not able to fix the function.

I then asked it to create a totally new function by describing what I wanted and using the sample input and expected output.

Function Consolidate(str As String) As String
  ' Check if the input string is empty or contains only spaces
  If Len(Trim(str)) = 0 Then
    ' Return an empty string
    Consolidate = ""
    Exit Function
  End If
  Dim parts() As String
  Dim result As String
  Dim i As Integer
  Dim currentChar As String
  parts = Split(str, " ")
  currentChar = parts(0)
  result = currentChar
  For i = 1 To UBound(parts)
    If Left(parts(i), 1) = Left(currentChar, 1) Then
      result = result & Mid(parts(i), 2)
      result = result & " " & parts(i)
      currentChar = Left(parts(i), 1)
    End If
  Next i
  Consolidate = result
End Function

This function takes in a string str and splits it into multiple parts using the space character as a delimiter. It then iterates through the parts and checks if the first character of each part is the same as the current character. If it is, it adds the rest of the part (excluding the first character) to the result string. Otherwise, it adds the whole part to the result string, separated by a space, and updates the current character to be the first character of the new part. Finally, it returns the result string as the output of the function.

Source: ChatGPT

I only have access to Excel 2016 at the moment, so I ran this in a Sub instead of as a custom function. I copied your inputs and tested it.

Sub Example()
  ' Define the input and output ranges
  Dim inputRange As range
  Set inputRange = range("A1:A12")
  Dim outputRange As range
  Set outputRange = range("C1")
  ' Loop through the cells in the input range
  Dim cell As range
  For Each cell In inputRange
    ' Apply the Consolidate function to the cell
    Dim result As String
    result = Consolidate(cell.Value)
    ' Paste the result to the corresponding cell in the output range
    outputRange.Cells(cell.Row - inputRange.Row + 1, cell.Column - inputRange.Column + 1).Value = result
  Next cell
End Sub
  • I see no evidence of any fuzzy testing being performed on the generated function
    – Ramhound
    Dec 13, 2022 at 12:01
  • It has only been tested with the inputs OP provided, correct. It assumes the duplicate letters will be sequential before another letter starts. I would need clarification if that does not match the use case and update accordingly.
    – MC10
    Dec 13, 2022 at 15:39
  • Hi MC10. It works perfectly for the inputs I provided. Sadly, when I tried on my whole data set it does not work as desired. For example, in my data there can be a cell with "D1 D2". Ideally the output would be "D12". As you said the letters are sequential.
    – Kenneth
    Dec 13, 2022 at 19:26
  • @Kenneth Good catch, it was missing the empty string/whitespace only cases as well (separate cases I tested), and also the first instance of currentChar from parts(0) was not compared using the first letter Left(currentChar, 1) but rather the whole token. I have updated the function.
    – MC10
    Dec 13, 2022 at 19:50
  • @Kenneth Glad to hear! That should be easy, I've updated the Sub. It now uses an output range, starting at C1 for example. It does not modify the original range and just takes the result of the function and puts it in the new range.
    – MC10
    Dec 14, 2022 at 0:16

Not the answer you're looking for? Browse other questions tagged or ask your own question.