Relocate Data Based On Text

[Matt Mc]

Alright, so I have been trolling the Intertubes and came across some VERY helpful code from this very forum, so it seems reasonable that the proper thing to do is ask the question in this very same forum.

What I have is a bunch of little routines to conduct simple Find(s) & Replace(s), as well as removing entire rows if a certain collection of text exists. What I think I want is for the Sub FR_blahblahblahs() that I have, I need the remaining text to be moved a certain row count up then column over.

<blockquote>
Sub AllRun()
Call DeleteRows
Call FR_Bracket
Call FR_Client
Call FR_DataMove
Call FR_NumberOfChanged
Call FR_TotalDataset
Call FR_TotalFiles
End Sub

Sub DeleteRows()
Dim x, lr As Long, lc As Integer
Dim a, b() As Variant, i As Long, e, k As Boolean
Application.ScreenUpdating = False
x = Array("Duration:", "#####", "Ended:", "* Successful run of rsync. Rotating. *")
lr = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, _
searchdirection:=xlPrevious).Row
lc = ActiveSheet.Cells.Find("*", SearchOrder:=xlByColumns, _
searchdirection:=xlPrevious).Column
If lc < 1 Then
MsgBox "Column A is unused" & Chr(10) & "Exiting"
Exit Sub
End If
a = Cells(1, "A").Resize(lr)
ReDim b(1 To lr, 1 To 1)
For i = 1 To lr: For Each e In x
If InStr(a(i, 1), e) > 0 Then
b(i, 1) = 1
k = True
End If
Next e, i
If k = False Then Exit Sub
Cells(1, lc + 1).Resize(lr) = b
Cells(1, 1).Resize(lr, lc + 1).Sort Cells(1, lc + 1), 1
Cells(1, 1).Resize(Cells(1, lc + 1).End(xlDown).Row, lc + 1).Delete 3
Application.ScreenUpdating = True
End Sub

Sub FR_Bracket()
Cells.Replace What:=" ]", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

Sub FR_TotalDataset()
Cells.Replace What:="Total Dataset Size: [ ", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
End Sub

Sub FR_Client()
Cells.Replace What:="Client: [ ", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
End Sub

Sub FR_NumberOfChanged()
Cells.Replace What:="Number of changed files: [ ", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
End Sub

Sub FR_TotalFiles()
Cells.Replace What:="Total number of files: [ ", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
End Sub

Sub FR_DataMove()
Cells.Replace What:="Data Moved: [ ", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
End Sub
</blockquote>

SPECIFIC CRITERIA
-DeleteRows() has to go first (I think), in order to make any of this make sense...
-FR_Client() will actually stay in Column A
-FR_NumberOfChanged() will move to Column B and up 1 row
-FR_TotalFiles() will move to Column C and up 2 rows
-FR_DataMove() will move to Column D and up 3 rows
-FR_TotalDataset() will move to Column E and up 4 rows
-Lastly, of course, I then need a final DeleteBlankRows to run...

Any takers? Am I completely out of my noggin?

 

[Matt Mc]

I did some more sniffing around and I found the following:
<blockquote>
Sub TransSheet()
sSheet = ActiveSheet.Name
Sheets.Add
dSheet = ActiveSheet.Name
For x = 1 To 5000 Step 7
Sheets(sSheet).Activate
Range(Cells(x, 1), Cells(x, 1).Offset(4, 0)).Select
Selection.Copy
Sheets(dSheet).Activate
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
ActiveCell.Offset(1, 0).Select
Next x
End Sub
</blockquote>
This kind of does what I want, but how can I take the FR_ entries and mix this together to just relocate the data based on the math I provided...?