Transponse

[Progr01]

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:

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

 

[Progr01]

Sorry, I can not post attachment, I am sending example in text body:

Device 1	2	3	4	5	5
Device 2	5	6	7	8
Device3	3	6	7	7	5
	0	0	0	0	0
	0	0	0	0	0
Device4	5634	653	3453	4653
Device5	6345	34563	5463	563
Devive6	#N/A	#N/A	#N/A	#N/A

<tbody>
</tbody>

And I want to look like this:

Device 1	2	3	4	5	5
	3
	4
	5
	5
Device 2	5	6	7	8
	6
	7
	8
Device3	3	6	7	7	5
	6
	7
	7
	5
	0	0	0	0	0
	0	0	0	0	0
Device4	5634	653	3453	4653
	653
	3453
	4653
Device5	6345	34563
	34563
Devive6	#N/A	#N/A	#N/A	#N/A

<tbody>
</tbody>

 

[Fluff]

How about

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

 

[Progr01]

Hello Fluff,

Thanks, it works excellent.

One more question. I have defined Columns like this:

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)

 

[Progr01]

I am sorry, something went wrong with my keyboard. I have defined Columns like this:

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:

    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?

Device 1	2	3
Device 2	5	6	7	8	78
Device3	3
Device4	5634	653	3453
Device5	6345	34563

<tbody>
</tbody>

Thanks

 

[Fluff]

I'm afraid I don't understand what you're asking.