Transpose duplicate data from columns to rows in excel.

I was working on a project where I encountered a challenge. There were over 14,000 rows of data, and many rows were repeated based on values in Column A. To address this, I wrote a macro to move duplicate entries into rows, aligning them horizontally. I’m sharing this macro with you—feel free to use it and leave feedback!



VBA Macro: Rearrange Duplicate Columns into Rows

Sub rearrange()
Dim a, n As Long, i As Long, u()
Dim g, m As Integer, k As Integer
a = Range("A1").CurrentRegion
n = UBound(a, 1)
ReDim u(1 To n, 1 To 5)
For i = 1 To n
    If a(i, 1) <> g Then
        k = k + 1
        g = a(i, 1)
        m = 2
        u(k, 1) = a(i, 1)
        u(k, 2) = a(i, 2)
    Else
        m = m + 1
        If m > 5 Then ReDim Preserve u(1 To n, 1 To m)
        u(k, m) = a(i, 2)
    End If
Next i
u(1, 1) = "Macro output"
Range("E1").Resize(k, UBound(u, 2)) = u
End Sub 

How to Use:

  1. Copy the code into the VBA editor (press Alt + F11 in Excel, then go to Insert > Module).
  2. Run the macro on a dataset where Column A has duplicate identifiers and Column B has corresponding values.
  3. The output will appear starting from Column E, with duplicates arranged in rows.

How to Save User Defined Function (SpellNumber) in Excel to work with it on all workbooks? (By One OF MY FRIEND --NB--)

Here's a refined version of your instructions for clarity and readability:

Step-by-Step Guide to Creating and Using a SpellNumber Add-In in Excel

Follow these steps to create a custom Add-In that converts numbers to words in Excel:

Step 1: Create the Add-In

  1. Open a New Workbook: Open Excel and press Alt + F11 to open the VBA editor.
  2. Insert the Code:
    • Paste the VBA code for converting numbers to text (words) into the module.
  3. Save as Add-In:
    • Go to File > Save As.
    • Select the file type as Excel Add-In:
      • For older versions (Excel 97-2003), choose Add-In 97-2003.
      • For newer versions (Excel 2007 and later), choose the simple Add-In option.
    • Save the file with a memorable name (e.g., SpellNumber).
  4. Close the VBA Editor: Press Alt + Q to close the VBA editor.

Step 2: Enable the Add-In in Excel

  1. Open Excel Options:
    • Open a new Excel workbook.
    • Click Office Button (Excel Menu) > Options > Add-Ins.
  2. Manage Add-Ins:
    • At the bottom of the Add-Ins window, under Manage [Excel Add-Ins], click Go.
  3. Activate the Add-In:
    • In the pop-up box, you will see a list of available Add-Ins, including the newly created SpellNumber.
    • Check the box next to SpellNumber and click OK.

Step 3: Use the SpellNumber Function

  1. Enter a Number:
    • Type a numeric value into any cell.
  2. Insert the Function:
    • Go to the Formulas tab and click Insert Function.
    • In the Category dropdown, select User Defined Functions.
    • Find and select the SpellNumber function.
  3. See the Result:
    • Once selected, the SpellNumber function will convert the numeric value into text.

Enjoy the solution!

About User-Defined Functions (UDFs) in Excel

Excel allows you to create custom formulas, known as User-Defined Functions (UDFs), using VBA. These can be used just like built-in functions such as SUM() or VLOOKUP(). UDFs expand Excel's functionality, especially for advanced calculations or text manipulations.

Example: Celsius to Fahrenheit UDF

Here's a simple example of a UDF to convert temperatures from Celsius to Fahrenheit:

Function CtoF(Centigrade As Double) As Double
    CtoF = Centigrade * 9 / 5 + 32
End Function

To use:

  1. Enter a Celsius value in a cell.
  2. Apply the CtoF function in another cell to get the Fahrenheit equivalent.

With these steps, you can create and use custom UDFs for various tasks in Excel. Let me know if you need help with any specific function or task!

Convert a numeric value into words in MSEXCEL

Steps:

Open EXCEL
press Alt+F11
Go to Insert>Module
paste the code below
Press Alt+Q
save it
go to excel sheet insert formula
SpellNumber()

put the value in (32) to convert to word

NOTE
its in Doller/cents
if you like to change the currency
simply search and replace
Dollars with []
cents with []

on request of a friend
if your currenty value is high

replace
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2))
With
Cents = GetHundreds(Left(Mid(MyNumber, DecimalPlace + 1) & _"000", 3))

CODE
Start copy below the line
------------------------------------------------

Option Explicit

'****************
' Main Function *
'****************

Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count

ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "

' String representation of amount.
MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If

Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select

Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select

SpellNumber = Dollars & Cents
End Function



'*******************************************
' Converts a number from 100-999 into text *
'*******************************************

Function GetHundreds(ByVal MyNumber)
Dim Result As String

If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)

' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If

' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If

GetHundreds = Result
End Function



'*********************************************
' Converts a number from 10 to 99 into text. *
'*********************************************

Function GetTens(TensText)
Dim Result As String

Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function




'*******************************************
' Converts a number from 1 to 9 into text. *
'*******************************************

Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function


------------------------------------------------
end copy above the line(dont copy the line)