Moving Data into destination sheet and formatting output
I have my data in columns A:L in Sheet2 and wish to copy each block based on the starting point, as certain cell text and the end point, again as certain cell text! The data is in columns A:L and move down down block by block
The code I have is very nearly 100% complete, but the last part I am trying to achieve is to put each item in a specific order on the destination sheet. As we know columns are A:L I want to paste my first block into Columns A:L in the destination then the next one in M:X then the final one in Y:AJ.
As there are about 10 of these blocks, Tank Engine, Weatherman etc I envisage, that I will need three blocks first, then a about three rows which are gaps before it is then repeated.
An example of this
The rows are dynamic but never more than 11 in length. The code I have is
Option Explicit
Sub MIKE3()
Dim wsSrc As Worksheet 'define source
Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
Dim wsDest As Worksheet 'define destination
Set wsDest = ThisWorkbook.Worksheets("Sheet2")
Dim FindList As Variant 'defind search words
FindList = Array("Tank Engine")
Dim i As Long
Dim FindItm As Variant
For Each FindItm In FindList
Dim CopyRange As Range
Set CopyRange = FindMyRange(wsSrc.Range("A:L"), FindItm, "INFORMATION: " & FindItm)
If Not CopyRange Is Nothing Then
CopyRange.Copy wsDest.Range("A1").Offset(ColumnOffset:=i) 'note that if the first column uses merged cells the ColumnOffset:=i otherwise it is ColumnOffset:=i*12
i = i + 1
End If
Next FindItm
End Sub
Function FindMyRange(SearchInRange As Range, ByVal StartString As String, ByVal EndString As String) As Range
'find start
Dim FoundStart As Range
Set FoundStart = SearchInRange.Find(What:=StartString, LookAt:=xlWhole)
If FoundStart Is Nothing Then GoTo ERR_NOTHING_FOUND
find end
Dim FoundEnd As Range
Set FoundEnd = SearchInRange.Find(What:=EndString, LookAt:=xlWhole, After:=FoundStart)
If FoundEnd Is Nothing Then GoTo ERR_NOTHING_FOUND
Set FindMyRange = SearchInRange.Parent.Range(FoundStart, FoundEnd).Resize(ColumnSize:=12)
Exit Function'
ERR_NOTHING_FOUND:
FindMyRange = Nothing
End Function
thanks to PEH for his initial help and Thank you for looking!
excel vba
add a comment |
I have my data in columns A:L in Sheet2 and wish to copy each block based on the starting point, as certain cell text and the end point, again as certain cell text! The data is in columns A:L and move down down block by block
The code I have is very nearly 100% complete, but the last part I am trying to achieve is to put each item in a specific order on the destination sheet. As we know columns are A:L I want to paste my first block into Columns A:L in the destination then the next one in M:X then the final one in Y:AJ.
As there are about 10 of these blocks, Tank Engine, Weatherman etc I envisage, that I will need three blocks first, then a about three rows which are gaps before it is then repeated.
An example of this
The rows are dynamic but never more than 11 in length. The code I have is
Option Explicit
Sub MIKE3()
Dim wsSrc As Worksheet 'define source
Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
Dim wsDest As Worksheet 'define destination
Set wsDest = ThisWorkbook.Worksheets("Sheet2")
Dim FindList As Variant 'defind search words
FindList = Array("Tank Engine")
Dim i As Long
Dim FindItm As Variant
For Each FindItm In FindList
Dim CopyRange As Range
Set CopyRange = FindMyRange(wsSrc.Range("A:L"), FindItm, "INFORMATION: " & FindItm)
If Not CopyRange Is Nothing Then
CopyRange.Copy wsDest.Range("A1").Offset(ColumnOffset:=i) 'note that if the first column uses merged cells the ColumnOffset:=i otherwise it is ColumnOffset:=i*12
i = i + 1
End If
Next FindItm
End Sub
Function FindMyRange(SearchInRange As Range, ByVal StartString As String, ByVal EndString As String) As Range
'find start
Dim FoundStart As Range
Set FoundStart = SearchInRange.Find(What:=StartString, LookAt:=xlWhole)
If FoundStart Is Nothing Then GoTo ERR_NOTHING_FOUND
find end
Dim FoundEnd As Range
Set FoundEnd = SearchInRange.Find(What:=EndString, LookAt:=xlWhole, After:=FoundStart)
If FoundEnd Is Nothing Then GoTo ERR_NOTHING_FOUND
Set FindMyRange = SearchInRange.Parent.Range(FoundStart, FoundEnd).Resize(ColumnSize:=12)
Exit Function'
ERR_NOTHING_FOUND:
FindMyRange = Nothing
End Function
thanks to PEH for his initial help and Thank you for looking!
excel vba
add a comment |
I have my data in columns A:L in Sheet2 and wish to copy each block based on the starting point, as certain cell text and the end point, again as certain cell text! The data is in columns A:L and move down down block by block
The code I have is very nearly 100% complete, but the last part I am trying to achieve is to put each item in a specific order on the destination sheet. As we know columns are A:L I want to paste my first block into Columns A:L in the destination then the next one in M:X then the final one in Y:AJ.
As there are about 10 of these blocks, Tank Engine, Weatherman etc I envisage, that I will need three blocks first, then a about three rows which are gaps before it is then repeated.
An example of this
The rows are dynamic but never more than 11 in length. The code I have is
Option Explicit
Sub MIKE3()
Dim wsSrc As Worksheet 'define source
Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
Dim wsDest As Worksheet 'define destination
Set wsDest = ThisWorkbook.Worksheets("Sheet2")
Dim FindList As Variant 'defind search words
FindList = Array("Tank Engine")
Dim i As Long
Dim FindItm As Variant
For Each FindItm In FindList
Dim CopyRange As Range
Set CopyRange = FindMyRange(wsSrc.Range("A:L"), FindItm, "INFORMATION: " & FindItm)
If Not CopyRange Is Nothing Then
CopyRange.Copy wsDest.Range("A1").Offset(ColumnOffset:=i) 'note that if the first column uses merged cells the ColumnOffset:=i otherwise it is ColumnOffset:=i*12
i = i + 1
End If
Next FindItm
End Sub
Function FindMyRange(SearchInRange As Range, ByVal StartString As String, ByVal EndString As String) As Range
'find start
Dim FoundStart As Range
Set FoundStart = SearchInRange.Find(What:=StartString, LookAt:=xlWhole)
If FoundStart Is Nothing Then GoTo ERR_NOTHING_FOUND
find end
Dim FoundEnd As Range
Set FoundEnd = SearchInRange.Find(What:=EndString, LookAt:=xlWhole, After:=FoundStart)
If FoundEnd Is Nothing Then GoTo ERR_NOTHING_FOUND
Set FindMyRange = SearchInRange.Parent.Range(FoundStart, FoundEnd).Resize(ColumnSize:=12)
Exit Function'
ERR_NOTHING_FOUND:
FindMyRange = Nothing
End Function
thanks to PEH for his initial help and Thank you for looking!
excel vba
I have my data in columns A:L in Sheet2 and wish to copy each block based on the starting point, as certain cell text and the end point, again as certain cell text! The data is in columns A:L and move down down block by block
The code I have is very nearly 100% complete, but the last part I am trying to achieve is to put each item in a specific order on the destination sheet. As we know columns are A:L I want to paste my first block into Columns A:L in the destination then the next one in M:X then the final one in Y:AJ.
As there are about 10 of these blocks, Tank Engine, Weatherman etc I envisage, that I will need three blocks first, then a about three rows which are gaps before it is then repeated.
An example of this
The rows are dynamic but never more than 11 in length. The code I have is
Option Explicit
Sub MIKE3()
Dim wsSrc As Worksheet 'define source
Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
Dim wsDest As Worksheet 'define destination
Set wsDest = ThisWorkbook.Worksheets("Sheet2")
Dim FindList As Variant 'defind search words
FindList = Array("Tank Engine")
Dim i As Long
Dim FindItm As Variant
For Each FindItm In FindList
Dim CopyRange As Range
Set CopyRange = FindMyRange(wsSrc.Range("A:L"), FindItm, "INFORMATION: " & FindItm)
If Not CopyRange Is Nothing Then
CopyRange.Copy wsDest.Range("A1").Offset(ColumnOffset:=i) 'note that if the first column uses merged cells the ColumnOffset:=i otherwise it is ColumnOffset:=i*12
i = i + 1
End If
Next FindItm
End Sub
Function FindMyRange(SearchInRange As Range, ByVal StartString As String, ByVal EndString As String) As Range
'find start
Dim FoundStart As Range
Set FoundStart = SearchInRange.Find(What:=StartString, LookAt:=xlWhole)
If FoundStart Is Nothing Then GoTo ERR_NOTHING_FOUND
find end
Dim FoundEnd As Range
Set FoundEnd = SearchInRange.Find(What:=EndString, LookAt:=xlWhole, After:=FoundStart)
If FoundEnd Is Nothing Then GoTo ERR_NOTHING_FOUND
Set FindMyRange = SearchInRange.Parent.Range(FoundStart, FoundEnd).Resize(ColumnSize:=12)
Exit Function'
ERR_NOTHING_FOUND:
FindMyRange = Nothing
End Function
thanks to PEH for his initial help and Thank you for looking!
excel vba
excel vba
edited Nov 21 at 9:40
Pᴇʜ
20.2k42650
20.2k42650
asked Nov 21 at 9:33
user3515236
144
144
add a comment |
add a comment |
1 Answer
1
active
oldest
votes
I managed to make this work by editing the strings in my source data then writing x number of macros to cover my scenarios then calling them one by one in a module
add a comment |
Your Answer
StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "1"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53408980%2fmoving-data-into-destination-sheet-and-formatting-output%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
1 Answer
1
active
oldest
votes
1 Answer
1
active
oldest
votes
active
oldest
votes
active
oldest
votes
I managed to make this work by editing the strings in my source data then writing x number of macros to cover my scenarios then calling them one by one in a module
add a comment |
I managed to make this work by editing the strings in my source data then writing x number of macros to cover my scenarios then calling them one by one in a module
add a comment |
I managed to make this work by editing the strings in my source data then writing x number of macros to cover my scenarios then calling them one by one in a module
I managed to make this work by editing the strings in my source data then writing x number of macros to cover my scenarios then calling them one by one in a module
answered Nov 21 at 14:53
user3515236
144
144
add a comment |
add a comment |
Thanks for contributing an answer to Stack Overflow!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
Some of your past answers have not been well-received, and you're in danger of being blocked from answering.
Please pay close attention to the following guidance:
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53408980%2fmoving-data-into-destination-sheet-and-formatting-output%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown