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. 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