Macro creation in excel using VBA code

Question

1.00/5 (2 votes)

See more:

Hi,

I want to create a macro with the below requirement:-

A	B	C
1234	Color	 Blue
1234	Width	 1.5"
1234	Supplier XYX

output required
A        Colour  Width   Supplier
1234     Blue    1.5"     XYX

What I have tried:

I want to create a macro using VBA code.

Posted 24-Mar-19 23:48pm

chints786

Updated 25-Mar-19 2:53am

Patrice T

v2

Add a Solution

Comments

Mohibur Rashid 25-Mar-19 6:01am

And? What prblem are you facing?

chints786 25-Mar-19 6:17am

I havent created a macro yet. so I dont know how it is made.

On internet i found the below code

Option Explicit

Sub ATransProd()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Input")
Set s2 = Sheets("OutputX")
s2.Range("A1") = s1.Range("A1")
s2.Range("B1") = "Producto"
s2.Range("C1") = "Unidad"
s1.Range("L1:N1").Copy s2.Range("D1")
Dim lr As Long, lr2 As Long, i As Long
lr = s1.Range("A" & Rows.Count).End(xlUp).Row
With s1
For i = 2 To lr
lr2 = s2.Range("B" & Rows.Count).End(xlUp).Row
.Range("A" & i).Copy s2.Range("A" & lr2 + 1)
.Range("B" & i & ":F" & i).Copy
s2.Range("B" & lr2 + 1).PasteSpecial xlPasteValues, , , True
.Range("G" & i & ":K" & i).Copy
s2.Range("C" & lr2 + 1).PasteSpecial xlPasteValues, , , True
.Range("L" & i & ":N" & i).Copy s2.Range("D" & lr2 + 1)
Next i
End With
Application.CutCopyMode = False
lr2 = s2.Range("B" & Rows.Count).End(xlUp).Row
For i = lr2 To 2 Step -1
If s2.Range("C" & i) = "" Then
s2.Range("C" & i).EntireRow.Delete
End If
Next i
With s2
For i = 3 To lr2
If .Range("A" & i) = "" Then
.Range("A" & i) = .Range("A" & i - 1)
.Range("D" & i) = .Range("D" & i - 1)
.Range("E" & i) = .Range("E" & i - 1)
.Range("F" & i) = .Range("F" & i - 1)
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "completed"
End Sub

2 solutions

Solution 1

Use the Macro Record feature.
- Start recording
- Perform the actions you want
- Stop recording.
You can now edit and modify the macro as required.

Posted 25-Mar-19 0:06am

Richard MacCutchan

Comments

chints786 25-Mar-19 6:17am

Richard i want to create a macro, I haven't created it anytime
so please help me to create it.

Richard MacCutchan 25-Mar-19 6:35am

Follow the instructions above. Alternatively read Quick start: Create a macro - Office Support[^].

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Maciej Los · Accepted Answer · 2019-03-25T02:54:00

Assuming that a worksheet #1 contains the data listed below, started from A1 cell:

ID	Property	Value
1234	Color	Blue
1234	Width	1.5"
1234	Supplier	XYX
1235	Color	Orange
1235	Width	3.5"
1235	Supplier	ZZA

and you want to achieve something like that (in a #2 worksheet):

ID	Color	Width	Supplier
1234	Blue	1.5"	XYX
1235	Orange	3.5"	ZZA

below macro should do the job:

VB

Option Explicit

Sub RowsToColumns()
    Dim i As Integer, j As Integer, k As Integer
    Dim srcWsh As Worksheet, dstWsh As Worksheet
    
    On Error GoTo Err_RowsToColumns

    'you need to change a code-context!
    'read below comments
    Set srcWsh = ThisWorkbook.Worksheets(1) 'refers to first worksheet in a workbook - source worksheet
    Set dstWsh = ThisWorkbook.Worksheets(2) 'refers to second worksheet in a workbook - destination worksheet
    dstWsh.Cells.Delete xlShiftUp 'clean up first!
    With dstWsh.Range("A1")
        .Value = "ID"
        .Font.Bold = True
        .Interior.Color = vbGreen
    End With
    
    i = 2
    j = 2
    Do While srcWsh.Range("A" & i) <> ""
        'ID
        dstWsh.Range("A" & j) = srcWsh.Range("A" & i)
        'other properties
        k = 0
        Do While srcWsh.Range("A" & i + k) = srcWsh.Range("A" & i)
            With dstWsh.Range("B1").Offset(ColumnOffset:=k)
                .Value = srcWsh.Range("B" & i + k)
                .Font.Bold = True
                .Interior.Color = vbGreen
            End With
            dstWsh.Range("B" & j).Offset(ColumnOffset:=k) = srcWsh.Range("C" & i + k)
            k = GetColumnNo(srcWsh.Range("B" & i + k), dstWsh)
        Loop
        i = i + k
        j = j + 1
    Loop
    
Exit_RowsToColumns:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    Exit Sub

Err_RowsToColumns:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_RowsToColumns


End Sub

Function GetColumnNo(sHeader As String, wsh As Worksheet) As Integer
    Dim c As Integer
    
    c = 0
    Do While wsh.Range("A1").Offset(ColumnOffset:=c) <> ""
        If wsh.Range("A1").Offset(ColumnOffset:=c) = sHeader Then Exit Do
        c = c + 1
    Loop
    
    GetColumnNo = c

End Function

Note: the data and above macro should be in the same workbook.