Transpose VBA Excel [Closed]

Question

Previous Topic Next Topic

Transpose VBA Excel [Closed]

Report

plexus2121

Posts: 2
Registration date: Monday February 4, 2019
Status: Member
Last seen: February 6, 2019

- Feb 4, 2019 at 09:11 AM
TrowaD

Posts: 2757
Registration date: Sunday September 12, 2010
Status: Moderator
Last seen: June 8, 2021

- Feb 11, 2019 at 12:30 PM

Hi,

I require a macro that performs a specific transpose action.

Please see pre table example and desired post data set. I have searched for threads with solutions but could not find one that worked for me, however apologies if there is a thread that covers this and i have missed it.

Original data located in 'Sheet1':

SKU DESC CH 1 CH 2 CH 3 CH 4 Online Status Date Time

ALC23245 Handset Stores Fran Bus Partner In Stock 04/02/2019 11am
ALC99999 Handset Stores Fran (blanc) (blanc) In Stock 04/02/2019 11am
ALC53456 Handset Stores Fran Bus (blanc) In Stock 04/02/2019 11am

(blanc) are actually empty cells.

Required output located in 'Sheet2':

SKU DESC CH Online Status Date Time

ALC23245 Handset Stores In Stock 04/02/2019 11am
ALC23245 Handset Fran In Stock 04/02/2019 11am
ALC23245 Handset Bus In Stock 04/02/2019 11am
ALC23245 Handset Partner In Stock 04/02/2019 11am
ALC99999 Handset Stores In Stock 04/02/2019 11am
ALC99999 Handset Fran In Stock 04/02/2019 11am
ALC53465 Handset Stores In Stock 04/02/2019 11am
ALC53465 Handset Fran In Stock 04/02/2019 11am
ALC53465 Handset Bus In Stock 04/02/2019 11am

I actually have 16 columns of the channels (CH 1 CH 2 ETC), was not practical to illustrate here. The channel columns will always be populated in order - there will be no blank cells followed by more data.

My VBA is somewhat limited. I did find a thread that had something close to what I want but was unable edit the code to fit my requirements:

https://ccm.net/forum/affich-689461-macro-to-copy-paste-down-x-times-where-x-is-the-number-of-rows

I greatly appreciate any help!

Thanks,

Plex.

Excel transpose vba
Excel vba transpose - Best answers
Excel vba transpose range - Best answers
Search function vba excel - How-To - Excel
Vba excel copy data from one workbook to another - How-To - Excel
VBA Excel Color Codes - How-To - Excel
Search function in VBA/Excel - How-To - Excel
VBA Excel - Password and Users - How-To - Excel

2 replies

Answer 2 / 2

Blocked Profile
Feb 4, 2019 at 05:22 PM

So, do you know how to build a loop? Can you build an array?

Post your code snippet from the example you reference, and we can help.

Ask a question

TrowaD · Accepted Answer · 2019-02-05T12:11:12-0500

Answer 1 / 2

TrowaD

Posts: 2757
Registration date: Sunday September 12, 2010
Status: Moderator
Last seen: June 8, 2021

462
Feb 5, 2019 at 12:11 PM

Hi Plexus,

The following code will work for your sample data:

Sub RunMe()
Dim lRow, x As Integer

Sheets("Sheet1").Select
lRow = Range("A1").End(xlDown).Row

For Each cell In Range("A2:A" & lRow)
    If cell.Offset(0, 3).Value = vbNullString Then
        x = 1
    ElseIf cell.Offset(0, 4).Value = vbNullString Then
        x = 2
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 3
    Else
        x = 4
    End If
    
    Range(cell, cell.Offset(0, 1)).Copy
    Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(x).PasteSpecial
    
    Range(cell.Offset(0, 6), cell.Offset(0, 8)).Copy
    Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Resize(x).PasteSpecial
    
    cell.Offset(0, 2).Resize(1, x).Copy
    Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    
Next cell
Application.CutCopyMode = False
End Sub

Then I read you had 16 channels ...
Can you adjust the code to make that happen?

Best regards,
Trowa

Report

plexus2121

Posts: 2
Registration date: Monday February 4, 2019
Status: Member
Last seen: February 6, 2019

Feb 6, 2019 at 09:17 AM

Hi Trowa,

Thank you so much for your help. I have edited the code to work on 16 channels. I also added some paste special values. One thing that I am unable to solve is the code does not handle empty cells in channels when pasting into sheet 2. It pastes down incorrectly then gets out of sync. Here is what I have:

Sub RunMe()
Dim lRow, x As Integer

Sheets("Sheet1").Select
lRow = Range("A1").End(xlDown).Row

For Each cell In Range("A2:A" & lRow)
    If cell.Offset(0, 3).Value = vbNullString Then
        x = 1
    ElseIf cell.Offset(0, 4).Value = vbNullString Then
        x = 2
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 3
     ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 4
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 5
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 6
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 7
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 8
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 9
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 10
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 11
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 12
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 13
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 14
    ElseIf cell.Offset(0, 5).Value = vbNullString Then
        x = 15
    Else
        x = 16
    End If
    
    
    
    Range(cell, cell.Offset(0, 1)).Copy
    Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(x).PasteSpecial xlPasteValues
    
    Range(cell.Offset(0, 18), cell.Offset(0, 21)).Copy
    Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Resize(x).PasteSpecial xlPasteValues
    
    cell.Offset(0, 2).Resize(1, x).Copy
    Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
Next cell
Application.CutCopyMode = False
End Sub

I was confused as to what this step is doing and was wondering if this is causing the problem?

  cell.Offset(0, 2).Resize(1, x).Copy
    Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Transpose:=True

Once again thanks for your help!

Plex.

Report

TrowaD

Posts: 2757
Registration date: Sunday September 12, 2010
Status: Moderator
Last seen: June 8, 2021

462
Feb 11, 2019 at 12:30 PM

Hi Plex,

You were almost there, you just overlooked something.

The part where x is determined, the offset value for the column should increase by 1. In the amended code it goes from 3, 4, 5, 5, 5 .... instead of 3, 4, 5, 6, 7 ....

cell.Offset(0, 2).Resize(1, x).Copy

Take the cell from Range("A2:A" & lRow), then 2 cells to the right (offest(0,2) and then resize that cells to the number of channels that have values in them.

Let me know if something is still unclear.

Best regards,
Trowa

Transpose VBA Excel [Closed]

2 replies

Your reply

Subscribe To Our Newsletter!