BUILD A SET OF DATA BASED ON SOME FILTERS

[RIC63]

Morning,

I need to analyze a lot of column -i.e. E12 ÷ AT25- and for each one


if there is only one number then the content of B84 must be copied -by paste special only value- on row 26 of that column




if there is more than one number then the contain of C84 ÷ C86 must be copied -via paste special only value- on row 26 of that column


then after each column that contain more than one number a new one must be inserted and filled with the data present in B64 ÷ B81 allways -via paste special only value-


On sheet 'Result' i show the result of the above steps

I currently use excel 2010 and also 2021

Thanks for any suggestions

[p45cal]

Try this macro which works on the ACTIVE SHEET:
Sub blah()
On Error GoTo myError
Application.ScreenUpdating = False
With Range("E11:AT25")
For colm = .Columns.Count To 1 Step -1
Set thiscolm = .Columns(colm)
Select Case Application.Count(thiscolm)
Case 0
'nothing
Case 1
Range("B84").Copy
thiscolm.Resize(1).Offset(thiscolm.Rows.Count).PasteSpecial Paste:=xlPasteValues
Case Else
Range("C84:C86").Copy
thiscolm.Resize(1).Offset(thiscolm.Rows.Count).PasteSpecial Paste:=xlPasteValues
thiscolm.Offset(, 1).EntireColumn.Insert
Range("B64:B81").Copy
thiscolm.Offset(, 1).PasteSpecial Paste:=xlPasteValues
End Select
Next colm
End With
myError:
Application.ScreenUpdating = True
End Sub

[RIC63]

good morning p45cal
thank you


the routine does exactly what I wanted, I do some testing on a larger dataset but I'm convinced it's ok


Thanks again

[snb]

It's an exercise to work with Arrays in VBA:


Sub M_snb()
With Foglio1
.Range("AU10:AU27").NumberFormat = "@"
.Range("AU11:AU28") = .Range("B64:B81").Value
.Range("E26:AT26") = "'01"

sn = .Range("E8:AU32")
End With

For jj = 1 To UBound(sn, 2) - 1
c00 = c00 & " " & jj
If sn(1, jj) > 1 Then
c00 = c00 & " " & UBound(sn, 2)
sn(20, jj) = 2
sn(21, jj) = 1
End If
Next

sp = Application.Index(sn, [row(1:25)], Split(Trim(c00)))
With Foglio1.Cells(100, 1).Resize(UBound(sp), UBound(sp, 2) - 1)
.NumberFormat = "@"
.Value = sp
End With
End Sub

[RIC63]

good morning snb
thanks to you too for the support