Transponse

P

Progr01

New Member
Joined
Jul 18, 2017
Messages
9
Hello,

I have a table like in attachment and I would like to sort data like in table below. If cell.Value in B1 is > 0 then I want to insert numbers of rows below = how many cells on the right have
value > 0, then I want to copy those numbers in this cells below - transpose. In this case I need to insert 4 rows below. If value is 0 or #N/A nothing happens.

I want to do it for all rows in ActiveSheet.

I have started like this, this is only beginening:

Code: 
For Each cell in range ("B:B")

If B2.value > 0 then

Range("B2").Select
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert

    Range("C1:F1").Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("I5").Select

End if

Next

thanks
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
Sorry, I can not post attachment, I am sending example in text body:

[TABLE="width: 384"]
<tbody>[TR]
[TD="class: xl63, width: 64"]Device 1[/TD]
[TD="class: xl63, width: 64, align: right"]2[/TD]
[TD="class: xl63, width: 64, align: right"]3[/TD]
[TD="class: xl63, width: 64, align: right"]4[/TD]
[TD="class: xl63, width: 64, align: right"]5[/TD]
[TD="class: xl63, width: 64, align: right"]5[/TD]
[/TR]
[TR]
[TD="class: xl63"]Device 2[/TD]
[TD="class: xl63, align: right"]5[/TD]
[TD="class: xl63, align: right"]6[/TD]
[TD="class: xl63, align: right"]7[/TD]
[TD="class: xl63, align: right"]8[/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]Device3[/TD]
[TD="class: xl63, align: right"]3[/TD]
[TD="class: xl63, align: right"]6[/TD]
[TD="class: xl63, align: right"]7[/TD]
[TD="class: xl63, align: right"]7[/TD]
[TD="class: xl63, align: right"]5[/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl63, align: right"]0[/TD]
[TD="class: xl63, align: right"]0[/TD]
[TD="class: xl63, align: right"]0[/TD]
[TD="class: xl63, align: right"]0[/TD]
[TD="class: xl63, align: right"]0[/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl63, align: right"]0[/TD]
[TD="class: xl63, align: right"]0[/TD]
[TD="class: xl63, align: right"]0[/TD]
[TD="class: xl63, align: right"]0[/TD]
[TD="class: xl63, align: right"]0[/TD]
[/TR]
[TR]
[TD="class: xl63"]Device4[/TD]
[TD="class: xl63, align: right"]5634[/TD]
[TD="class: xl63, align: right"]653[/TD]
[TD="class: xl63, align: right"]3453[/TD]
[TD="class: xl63, align: right"]4653[/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]Device5[/TD]
[TD="class: xl63, align: right"]6345[/TD]
[TD="class: xl63, align: right"]34563[/TD]
[TD="class: xl63, align: right"]5463[/TD]
[TD="class: xl63, align: right"]563[/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]Devive6[/TD]
[TD="class: xl63, align: center"]#N/A[/TD]
[TD="class: xl63, align: center"]#N/A[/TD]
[TD="class: xl63, align: center"]#N/A[/TD]
[TD="class: xl63, align: center"]#N/A[/TD]
[TD="class: xl63"][/TD]
[/TR]
</tbody>[/TABLE]
And I want to look like this:

[TABLE="width: 384"]
<tbody>[TR]
[TD="class: xl65, width: 64"]Device 1[/TD]
[TD="class: xl65, width: 64, align: right"]2[/TD]
[TD="class: xl65, width: 64, align: right"]3[/TD]
[TD="class: xl65, width: 64, align: right"]4[/TD]
[TD="class: xl65, width: 64, align: right"]5[/TD]
[TD="class: xl65, width: 64, align: right"]5[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]3[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]4[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]5[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]5[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"]Device 2[/TD]
[TD="class: xl65, align: right"]5[/TD]
[TD="class: xl65, align: right"]6[/TD]
[TD="class: xl65, align: right"]7[/TD]
[TD="class: xl65, align: right"]8[/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]6[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]7[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]8[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"]Device3[/TD]
[TD="class: xl65, align: right"]3[/TD]
[TD="class: xl65, align: right"]6[/TD]
[TD="class: xl65, align: right"]7[/TD]
[TD="class: xl65, align: right"]7[/TD]
[TD="class: xl65, align: right"]5[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]6[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]7[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]7[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]5[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]0[/TD]
[TD="class: xl65, align: right"]0[/TD]
[TD="class: xl65, align: right"]0[/TD]
[TD="class: xl65, align: right"]0[/TD]
[TD="class: xl65, align: right"]0[/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]0[/TD]
[TD="class: xl65, align: right"]0[/TD]
[TD="class: xl65, align: right"]0[/TD]
[TD="class: xl65, align: right"]0[/TD]
[TD="class: xl65, align: right"]0[/TD]
[/TR]
[TR]
[TD="class: xl65"]Device4[/TD]
[TD="class: xl65, align: right"]5634[/TD]
[TD="class: xl65, align: right"]653[/TD]
[TD="class: xl65, align: right"]3453[/TD]
[TD="class: xl65, align: right"]4653[/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]653[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]3453[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]4653[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"]Device5[/TD]
[TD="class: xl65, align: right"]6345[/TD]
[TD="class: xl65, align: right"]34563[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"][/TD]
[TD="class: xl65, align: right"]34563[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl65"]Devive6[/TD]
[TD="class: xl65, align: center"]#N/A[/TD]
[TD="class: xl65, align: center"]#N/A[/TD]
[TD="class: xl65, align: center"]#N/A[/TD]
[TD="class: xl65, align: center"]#N/A[/TD]
[TD="class: xl65"][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
How about
Code: 
Sub InsertTranspose()
   Dim Cnt As Long
   Dim Rws As Long
   
   For Cnt = Range("B" & Rows.Count).End(xlUp).Row To 1 Step -1
      If Not IsError(Range("B" & Cnt)) Then
         If Not Range("B" & Cnt).Value = 0 Then
            Rws = WorksheetFunction.CountIf(Range("C" & Cnt).Resize(, 4), ">0")
            Rows(Cnt + 1).Resize(Rws).Insert
            Range("B" & Cnt + 1).Resize(Rws).Value = Application.Transpose(Range("C" & Cnt).Resize(, Rws).Value)
         End If
      End If
   Next Cnt
End Sub
 
Upvote 0
Hello Fluff,

Thanks, it works excellent.

One more question. I have defined Columns like this:

Code: 
Kolona2 = Kolona_umetanje
    Raspon1 = 1
    Raspon2 = Lastrow
    
   
    Kolona_3 = Range(Kolona2 + ":" + Kolona2).Offset(0, 1).Address(0, 0, xlA1)
                p1 = InStr(Kolona_3, ":")
                Kolona_3 = Left(Kolona_3, p1 - 1)
                
    Kolona_4 = Range(Kolona_3 + ":" + Kolona_3).Offset(0, 1).Address(0, 0, xlA1)
                p2 = InStr(Kolona_4, ":")
                Kolona_4 = Left(Kolona_4, p2 - 1)
                            
                
    Kolona_5 = Range(Kolona_4 + ":" + Kolona_4).Offset(0, 1).Address(0, 0, xlA1)
                p3 = InStr(Kolona_5, ":")
                Kolona_5 = Left(Kolona_5, p3 - 1)
 
Upvote 0
I am sorry, something went wrong with my keyboard. I have defined Columns like this:

Code: 
Kolona2 = Kolona_umetanje
    Raspon1 = 1
    Raspon2 = Lastrow
    
    ' Column to the right of Column2
    Kolona_3 = Range(Kolona2 + ":" + Kolona2).Offset(0, 1).Address(0, 0, xlA1)
                p1 = InStr(Kolona_3, ":")
                Kolona_3 = Left(Kolona_3, p1 - 1)
    ' Column to the right of Column_3            
    Kolona_4 = Range(Kolona_3 + ":" + Kolona_3).Offset(0, 1).Address(0, 0, xlA1)
                p2 = InStr(Kolona_4, ":")
                Kolona_4 = Left(Kolona_4, p2 - 1)
                            
    ' Column to the right of Column_4            
    Kolona_5 = Range(Kolona_4 + ":" + Kolona_4).Offset(0, 1).Address(0, 0, xlA1)
                p3 = InStr(Kolona_5, ":")
                Kolona_5 = Left(Kolona_5, p3 - 1)

And I use FuzzyVLookup function like this to insert 4 numbers for devices:

Code: 
    ActiveSheet.Range(Kolona2 & Raspon1).Select
    
    ActiveCell.Formula = "=FuzzyVLookup(" & Kolona1 & "" & Raspon1 & ",'[BAZA_USPOREDBA.xlsm]BAZA_MOSAIC'!$A$1:$d$200,2,,,3)" '
    ActiveSheet.Range(Kolona2 & Raspon1).Select
    ActiveCell.Select
    Selection.AutoFill Destination:=Range(Kolona2 & Raspon1, Kolona2 & Raspon2)
    ActiveSheet.Range(Kolona2 & Raspon1, Kolona2 & Raspon2).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    
     
    
    ActiveSheet.Range(Kolona_3 & Raspon1).Select
    
    ActiveCell.Formula = "=FuzzyVLookup(" & Kolona1 & "" & Raspon1 & ",'[BAZA_USPOREDBA.xlsm]BAZA_MOSAIC'!$A$1:$d$200,3,,,3)" '
    ActiveSheet.Range(Kolona_3 & Raspon1).Select
    ActiveCell.Select
    Selection.AutoFill Destination:=Range(Kolona_3 & Raspon1, Kolona_3 & Raspon2)
    ActiveSheet.Range(Kolona_3 & Raspon1, Kolona_3 & Raspon2).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    
    ActiveSheet.Range(Kolona_4 & Raspon1).Select
    
    ActiveCell.Formula = "=FuzzyVLookup(" & Kolona1 & "" & Raspon1 & ",'[BAZA_USPOREDBA.xlsm]BAZA_MOSAIC'!$A$1:$d$200,4,,,3)" '
    ActiveSheet.Range(Kolona_4 & Raspon1).Select
    ActiveCell.Select
    Selection.AutoFill Destination:=Range(Kolona_4 & Raspon1, Kolona_4 & Raspon2) '
    ActiveSheet.Range(Kolona_4 & Raspon1, Kolona_4 & Raspon2).Select              '
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    
    ActiveSheet.Range(Kolona_5 & Raspon1).Select
    
    ActiveCell.Formula = "=FuzzyVLookup(" & Kolona1 & "" & Raspon1 & ",'[BAZA_USPOREDBA.xlsm]BAZA_MOSAIC'!$A$1:$d$200,5,,,3)" ' 
    ActiveSheet.Range(Kolona_5 & Raspon1).Select
    ActiveCell.Select
    Selection.AutoFill Destination:=Range(Kolona_5 & Raspon1, Kolona_5 & Raspon2) ' 
    ActiveSheet.Range(Kolona_5 & Raspon1, Kolona_5 & Raspon2).Select              ' 
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

Some device have 2 numbers some 5 or 6. Can we adapt your code in a way if FuzzyVLookup finds match to copy as many numbers we have in row for each device?

[TABLE="class: cms_table, width: 384"]
<tbody>[TR]
[/TR]
[TR]
[TD="class: cms_table_xl63, width: 64"]Device 1[/TD]
[TD="class: cms_table_xl63, width: 64, align: right"]2[/TD]
[TD="class: cms_table_xl63, width: 64, align: right"]3[/TD]
[TD="class: cms_table_xl63, width: 64, align: right"][/TD]
[TD="class: cms_table_xl63, width: 64, align: right"][/TD]
[TD="class: cms_table_xl63, width: 64, align: right"][/TD]
[/TR]
[TR]
[TD="class: cms_table_xl63"]Device 2[/TD]
[TD="class: cms_table_xl63, align: right"]5[/TD]
[TD="class: cms_table_xl63, align: right"]6[/TD]
[TD="class: cms_table_xl63, align: right"]7[/TD]
[TD="class: cms_table_xl63, align: right"]8[/TD]
[TD="class: cms_table_xl63"]78[/TD]
[/TR]
[TR]
[TD="class: cms_table_xl63"]Device3[/TD]
[TD="class: cms_table_xl63, align: right"]3[/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[/TR]
[TR]
[TD="class: cms_table_xl63"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[/TR]
[TR]
[TD="class: cms_table_xl63"]Device4[/TD]
[TD="class: cms_table_xl63, align: right"]5634[/TD]
[TD="class: cms_table_xl63, align: right"]653[/TD]
[TD="class: cms_table_xl63, align: right"]3453[/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63"][/TD]
[/TR]
[TR]
[TD="class: cms_table_xl63"]Device5[/TD]
[TD="class: cms_table_xl63, align: right"]6345[/TD]
[TD="class: cms_table_xl63, align: right"]34563[/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63, align: right"][/TD]
[TD="class: cms_table_xl63"][/TD]
[/TR]
[TR]
[TD="class: cms_table_xl63"][/TD]
[TD="class: cms_table_xl63, align: center"][/TD]
[TD="class: cms_table_xl63, align: center"][/TD]
[TD="class: cms_table_xl63, align: center"][/TD]
[TD="class: cms_table_xl63, align: center"][/TD]
[/TR]
</tbody>[/TABLE]


Thanks
 
Upvote 0
I'm afraid I don't understand what you're asking.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
VBA error
Replies
2
Views
159
normpam
N
K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
189
kbk
K
S
  • Question Question
Macro Formatting to all WS
Replies
4
Views
286
MARK858
MARK858
C
  • Question Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
420
myall_blues
myall_blues
J
  • Solved
Copy /past cells by inputbox on sheet 2 to sheet1 using VBA
2
Replies
12
Views
394
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

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