lundi 23 septembre 2019

Cut cells within a named range, containing a specific value and paste them to specified column

i have multiple rows that contain multiple columns of data, the data in each row is almost the same but the columns are in different orders.

What im trying to do is to align all of the data in the columns with the other rows so that each column contain the same value, maybe a screen shot will help explain better. Here is an example. Excel Screenshot This is only a small section but the sheet has many more columns and rows, i have named all active cells with a named range (allcells44), this is the area where i want to search.

I have managed to successfully complete this task which has taken me 2 days to put together through trial and error but i'm running multiple subs (254 subs together) all in one module which is extremely long and it is taking some time complete. here is what i have at the moment

Sub Findandcut1()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("I" & row).Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("I" & row).Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

Call Findandcut2

End Sub

Sub Findandcut2()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("J" & row).Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("J" & row).Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

Call Findandcut3

End Sub

Sub Findandcut3()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("K" & row).Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("K" & row).Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

Call Findandcut4

End Sub

This is only a small section of the vba code but it is just repeating it self and changing a few variables each time, so here is one section without calling the next sub. This is what i have.

Sub Findandcut1()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("I" & row).Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("I" & row).Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

End Sub

And This is what i want

Sub Findandcut1()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("allcells44").Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("allcells44").Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

End Sub

so i want to be able to search all cells in "named range" for value, Then cut and paste them to the specified column, but every variation i try seems to break my code, any help please. Thanks.

Aucun commentaire:

Enregistrer un commentaire