Macro to search a string, insert a new row, copy existent data, copy matching string

sn0w

New Member
Joined
Jan 1, 2013
Messages
4
Hello,

I need to create a macro who can search for a partial string (ex: TAR-WKS or TAR_LCD) on the H,J,I and K columns and if a string with that name it's found it should:

1. Insert a new line below the line where the string it's found.
2. Copy the content of the A,B,C,D and E columns from the line where the search string was found and paste them on the new line inserted at point 1, using same location - A on A, B on B, .., E on E.
3. CUT the found string along with the rest of the text (ex: TAR-WKS152 or TAR_LCD668) to the new line created as follows:

  • if it's TAR-WKS"a number" it should be pasted on the new line, column F.
  • if it's TAR_LCD"a number" it should be pasted on the new line, column G.

test environment, copy/paste it to an excel file.
IDOwnerCurrent ProjectProject's platformEmailPCMonitorOthers1Others2Others3Others4
532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649TAR_LCD669TAR-WKS152TAR_LCD668
532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650TAR-WKS149TAR_LCD665
532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651TAR-WKS144TAR_LCD666
532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652TAR-WKS150TAR_LCD660
532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653TAR-WKS146TAR_LCD661
532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654TAR-WKS146TAR_LCD659TAR-WKS147
532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655TAR_LCD664TAR_LCD670TAR-WKS151
532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656TAR_LCD663TAR-WKS145TAR-WKS146
532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657TAR-WKS147TAR_LCD667
532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658TAR_LCD662TAR-WKS148

<tbody>
</tbody>
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
sn0w,

Welcome to the MrExcel forum.

What version of Excel are you using?


If we start with this raw data:


Excel Workbook
ABCDEFGHIJK
1IDOwnerCurrent ProjectProject's platformEmailPCMonitorOthers1Others2Others3Others4
2532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649TAR_LCD669TAR-WKS152TAR_LCD668
3532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650TAR-WKS149TAR_LCD665
4532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651TAR-WKS144TAR_LCD666
5532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652TAR-WKS150TAR_LCD660
6532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653TAR-WKS146TAR_LCD661
7532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654TAR-WKS146TAR_LCD659TAR-WKS147
8532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655TAR_LCD664TAR_LCD670TAR-WKS151
9532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656TAR_LCD663TAR-WKS145TAR-WKS146
10532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657TAR-WKS147TAR_LCD667
11532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658TAR_LCD662TAR-WKS148
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sheet1





If I understand you correctly, is this what the results should look like?


Excel Workbook
ABCDEFGHIJK
1IDOwnerCurrent ProjectProject's platformEmailPCMonitorOthers1Others2Others3Others4
2532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649TAR_LCD669TAR-WKS152TAR_LCD668
3532110Will Smith1Project 1Platform 1mail 1TAR-WKS152
4532110Will Smith1Project 1Platform 1mail 1TAR_LCD669
5532110Will Smith1Project 1Platform 1mail 1TAR_LCD668
6532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650TAR-WKS149TAR_LCD665
7532111Will Smith2Project 2Platform 2mail 2TAR-WKS149
8532111Will Smith2Project 2Platform 2mail 2TAR_LCD665
9532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651TAR-WKS144TAR_LCD666
10532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652TAR-WKS150TAR_LCD660
11532113Will Smith4Project 4Platform 4mail 4TAR-WKS150
12532113Will Smith4Project 4Platform 4mail 4TAR_LCD660
13532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653TAR-WKS146TAR_LCD661
14532114Will Smith5Project 5Platform 5mail 5TAR-WKS146
15532114Will Smith5Project 5Platform 5mail 5TAR_LCD661
16532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654TAR-WKS146TAR_LCD659TAR-WKS147
17532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655TAR_LCD664TAR_LCD670TAR-WKS151
18532116Will Smith7Project 7Platform 7mail 7TAR-WKS151
19532116Will Smith7Project 7Platform 7mail 7TAR_LCD664
20532116Will Smith7Project 7Platform 7mail 7TAR_LCD670
21532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656TAR_LCD663TAR-WKS145TAR-WKS146
22532117Will Smith8Project 8Platform 8mail 8TAR-WKS145
23532117Will Smith8Project 8Platform 8mail 8TAR-WKS146
24532117Will Smith8Project 8Platform 8mail 8TAR_LCD663
25532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657TAR-WKS147TAR_LCD667
26532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658TAR_LCD662TAR-WKS148
27532119Will Smith10Project 10Platform 10mail 10TAR-WKS148
28532119Will Smith10Project 10Platform 10mail 10TAR_LCD662
29
Sheet1
 
Upvote 0
sn0w,


Sample raw data:


Excel Workbook
ABCDEFGHIJK
1IDOwnerCurrent ProjectProject's platformEmailPCMonitorOthers1Others2Others3Others4
2532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649TAR_LCD669TAR-WKS152TAR_LCD668
3532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650TAR-WKS149TAR_LCD665
4532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651TAR-WKS144TAR_LCD666
5532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652TAR-WKS150TAR_LCD660
6532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653TAR-WKS146TAR_LCD661
7532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654TAR-WKS146TAR_LCD659TAR-WKS147
8532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655TAR_LCD664TAR_LCD670TAR-WKS151
9532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656TAR_LCD663TAR-WKS145TAR-WKS146
10532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657TAR-WKS147TAR_LCD667
11532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658TAR_LCD662TAR-WKS148
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sheet1





After the macro:


Excel Workbook
ABCDEFGHIJK
1IDOwnerCurrent ProjectProject's platformEmailPCMonitorOthers1Others2Others3Others4
2532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649TAR_LCD669TAR-WKS152TAR_LCD668
3532110Will Smith1Project 1Platform 1mail 1TAR_LCD668
4532110Will Smith1Project 1Platform 1mail 1TAR-WKS152
5532110Will Smith1Project 1Platform 1mail 1TAR_LCD669
6532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650TAR-WKS149TAR_LCD665
7532111Will Smith2Project 2Platform 2mail 2TAR_LCD665
8532111Will Smith2Project 2Platform 2mail 2TAR-WKS149
9532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651TAR-WKS144TAR_LCD666
10532112Will Smith3Project 3Platform 3mail 3TAR_LCD666
11532112Will Smith3Project 3Platform 3mail 3TAR-WKS144
12532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652TAR-WKS150TAR_LCD660
13532113Will Smith4Project 4Platform 4mail 4TAR_LCD660
14532113Will Smith4Project 4Platform 4mail 4TAR-WKS150
15532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653TAR-WKS146TAR_LCD661
16532114Will Smith5Project 5Platform 5mail 5TAR_LCD661
17532114Will Smith5Project 5Platform 5mail 5TAR-WKS146
18532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654TAR-WKS146TAR_LCD659TAR-WKS147
19532115Will Smith6Project 6Platform 6mail 6TAR-WKS147
20532115Will Smith6Project 6Platform 6mail 6TAR_LCD659
21532115Will Smith6Project 6Platform 6mail 6TAR-WKS146
22532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655TAR_LCD664TAR_LCD670TAR-WKS151
23532116Will Smith7Project 7Platform 7mail 7TAR-WKS151
24532116Will Smith7Project 7Platform 7mail 7TAR_LCD670
25532116Will Smith7Project 7Platform 7mail 7TAR_LCD664
26532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656TAR_LCD663TAR-WKS145TAR-WKS146
27532117Will Smith8Project 8Platform 8mail 8TAR-WKS146
28532117Will Smith8Project 8Platform 8mail 8TAR-WKS145
29532117Will Smith8Project 8Platform 8mail 8TAR_LCD663
30532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657TAR-WKS147TAR_LCD667
31532118Will Smith9Project 9Platform 9mail 9TAR_LCD667
32532118Will Smith9Project 9Platform 9mail 9TAR-WKS147
33532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658TAR_LCD662TAR-WKS148
34532119Will Smith10Project 10Platform 10mail 10TAR-WKS148
35532119Will Smith10Project 10Platform 10mail 10TAR_LCD662
36
Sheet1





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code:
Option Explicit
Sub ReorgData()
' hiker95, 01/01/2013
' http://www.mrexcel.com/forum/excel-questions/676961-macro-search-string-insert-new-row-copy-existent-data-copy-matching-string.html
Dim r As Long, lr As Long, c As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 2 Step -1
  For c = 8 To 11 Step 1
    If Cells(r, c) <> "" Then
      Rows(r + 1).EntireRow.Insert
      Cells(r + 1, 1).Resize(, 5).Value = Cells(r, 1).Resize(, 5).Value
      If InStr(Cells(r, c), "TAR-") > 0 Then
        Cells(r + 1, 6).Value = Cells(r, c).Value
      ElseIf InStr(Cells(r, c), "TAR_") > 0 Then
        Cells(r + 1, 7).Value = Cells(r, c).Value
      End If
    End If
  Next c
Next r
Application.ScreenUpdating = True
End Sub


Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the ReorgData macro.
 
Upvote 0
Hi hiker95 and thank you very much for this macro. I use office 2010.

Indeed it does almost everything what i need except the CUT action from point 3. It does a copy witch it also good but if he will did a CUT and something escaped the macro (maybe a bad typo) it was easier to see because the broken valor was still on those 4 columns.
Speaking of bad typo, can you please add 4 more partial strings to search for on point 3, second bullet: "if it's TAR_LCD"a number" it should be pasted on the new line, column G." I will need also for macro to search AD_LCD"a number",PR-LCD"a number",BB_LCD"a number",DSI_LCD"a number".


Another thing that i forgot to ask if possible, is to have the macro results new lines + initial lines on 2nd sheet (sheet2).

RAW data on sheet1 - before running the macro.

ABCDEFGHIJK
1IDOwnerCurrent ProjectProject's platformEmailPCMonitorOthers1Others2Others3Others4
2532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649TAR_LCD669 TAR-WKS152TAR_LCD668
3532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650 TAR-WKS149 TAR_LCD665
4532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651TAR-WKS144 TAR_LCD666
5532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652 TAR-WKS150 TAR_LCD660
6532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653TAR-WKS146 TAR_LCD661
7532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654TAR-WKS146TAR_LCD659 TAR-WKS147
8532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655TAR_LCD664TAR_LCD670 TAR-WKS151
9532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656 TAR_LCD663TAR-WKS145TAR-WKS146
10532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657TAR-WKS147 TAR_LCD667
11532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658 TAR_LCD662TAR-WKS148

<tbody>
</tbody>

Data on sheet2, after running the macro:

ABCDEFGHIJK
1IDOwnerCurrent ProjectProject's platformEmailPCMonitor
2532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649
3532110Will Smith1Project 1Platform 1mail 1 TAR_LCD668
4532110Will Smith1Project 1Platform 1mail 1TAR-WKS152
5532110Will Smith1Project 1Platform 1mail 1 TAR_LCD669
6532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650
7532111Will Smith2Project 2Platform 2mail 2 TAR_LCD665
8532111Will Smith2Project 2Platform 2mail 2TAR-WKS149
9532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651
10532112Will Smith3Project 3Platform 3mail 3 TAR_LCD666
11532112Will Smith3Project 3Platform 3mail 3TAR-WKS144
12532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652
13532113Will Smith4Project 4Platform 4mail 4 TAR_LCD660
14532113Will Smith4Project 4Platform 4mail 4TAR-WKS150
15532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653
16532114Will Smith5Project 5Platform 5mail 5 TAR_LCD661
17532114Will Smith5Project 5Platform 5mail 5TAR-WKS146
18532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654
19532115Will Smith6Project 6Platform 6mail 6TAR-WKS147
20532115Will Smith6Project 6Platform 6mail 6 TAR_LCD659
21532115Will Smith6Project 6Platform 6mail 6TAR-WKS146
22532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655
23532116Will Smith7Project 7Platform 7mail 7TAR-WKS151
24532116Will Smith7Project 7Platform 7mail 7 TAR_LCD670
25532116Will Smith7Project 7Platform 7mail 7 TAR_LCD664
26532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656
27532117Will Smith8Project 8Platform 8mail 8TAR-WKS146
28532117Will Smith8Project 8Platform 8mail 8TAR-WKS145
29532117Will Smith8Project 8Platform 8mail 8 TAR_LCD663
30532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657
31532118Will Smith9Project 9Platform 9mail 9 TAR_LCD667
32532118Will Smith9Project 9Platform 9mail 9TAR-WKS147
33532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658
34532119Will Smith10Project 10Platform 10mail 10TAR-WKS148
35532119Will Smith10Project 10Platform 10mail 10 TAR_LCD662

<tbody>
</tbody>

Can this be done, it will be much easier to administrate high amount of data and keep the initial data untouched after macro it's run?

Many thanks and a great 2013!!!!
 
Upvote 0
sn0w,

Thanks for the new screenshots. It is always a good idea to display before and after screenshots, and worksheet names.

Can there be more Others# to the right of Others4?
 
Upvote 0
At this point i only work with those 4 but let's say that there can be Others5 and Other6 also.
 
Upvote 0
sn0w,


Sample worksheets:


Excel Workbook
ABCDEFGHIJK
1IDOwnerCurrent ProjectProject's platformEmailPCMonitorOthers1Others2Others3Others4
2532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649TAR_LCD669TAR-WKS152TAR_LCD668
3532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650TAR-WKS149TAR_LCD665
4532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651TAR-WKS144TAR_LCD666
5532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652TAR-WKS150TAR_LCD660
6532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653TAR-WKS146TAR_LCD661
7532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654TAR-WKS146TAR_LCD659TAR-WKS147
8532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655TAR_LCD664TAR_LCD670TAR-WKS151
9532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656TAR_LCD663TAR-WKS145TAR-WKS146
10532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657TAR-WKS147TAR_LCD667
11532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658TAR_LCD662TAR-WKS148
12
Sheet1





Excel Workbook
ABCDEFG
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sheet2





After the latest macro:


Excel Workbook
ABCDEFG
1IDOwnerCurrent ProjectProject's platformEmailPCMonitor
2532110Will Smith1Project 1Platform 1mail 1TAR-WKS134TAR_LCD649
3532110Will Smith1Project 1Platform 1mail 1TAR_LCD669
4532110Will Smith1Project 1Platform 1mail 1TAR-WKS152
5532110Will Smith1Project 1Platform 1mail 1TAR_LCD668
6532111Will Smith2Project 2Platform 2mail 2TAR-WKS135TAR_LCD650
7532111Will Smith2Project 2Platform 2mail 2TAR-WKS149
8532111Will Smith2Project 2Platform 2mail 2TAR_LCD665
9532112Will Smith3Project 3Platform 3mail 3TAR-WKS136TAR_LCD651
10532112Will Smith3Project 3Platform 3mail 3TAR-WKS144
11532112Will Smith3Project 3Platform 3mail 3TAR_LCD666
12532113Will Smith4Project 4Platform 4mail 4TAR-WKS137TAR_LCD652
13532113Will Smith4Project 4Platform 4mail 4TAR-WKS150
14532113Will Smith4Project 4Platform 4mail 4TAR_LCD660
15532114Will Smith5Project 5Platform 5mail 5TAR-WKS138TAR_LCD653
16532114Will Smith5Project 5Platform 5mail 5TAR-WKS146
17532114Will Smith5Project 5Platform 5mail 5TAR_LCD661
18532115Will Smith6Project 6Platform 6mail 6TAR-WKS139TAR_LCD654
19532115Will Smith6Project 6Platform 6mail 6TAR-WKS146
20532115Will Smith6Project 6Platform 6mail 6TAR_LCD659
21532115Will Smith6Project 6Platform 6mail 6TAR-WKS147
22532116Will Smith7Project 7Platform 7mail 7TAR-WKS140TAR_LCD655
23532116Will Smith7Project 7Platform 7mail 7TAR_LCD664
24532116Will Smith7Project 7Platform 7mail 7TAR_LCD670
25532116Will Smith7Project 7Platform 7mail 7TAR-WKS151
26532117Will Smith8Project 8Platform 8mail 8TAR-WKS141TAR_LCD656
27532117Will Smith8Project 8Platform 8mail 8TAR_LCD663
28532117Will Smith8Project 8Platform 8mail 8TAR-WKS145
29532117Will Smith8Project 8Platform 8mail 8TAR-WKS146
30532118Will Smith9Project 9Platform 9mail 9TAR-WKS142TAR_LCD657
31532118Will Smith9Project 9Platform 9mail 9TAR-WKS147
32532118Will Smith9Project 9Platform 9mail 9TAR_LCD667
33532119Will Smith10Project 10Platform 10mail 10TAR-WKS143TAR_LCD658
34532119Will Smith10Project 10Platform 10mail 10TAR_LCD662
35532119Will Smith10Project 10Platform 10mail 10TAR-WKS148
36
Sheet2





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code:
Option Explicit
Sub ReorgDataV2()
' hiker95, 01/02/2013
' http://www.mrexcel.com/forum/excel-questions/676961-macro-search-string-insert-new-row-copy-existent-data-copy-matching-string.html
Dim w1 As Worksheet, w2 As Worksheet
Dim r As Long, lr As Long, c As Long, lc As Long, nr As Long, n As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Sheet2!A1)") Then Worksheets.Add(After:=w1).Name = "Sheet2"
Set w2 = Worksheets("Sheet2")
w2.UsedRange.Clear
w2.Cells(1, 1).Resize(, 7).Value = w1.Cells(1, 1).Resize(, 7).Value
lr = w1.Cells(Rows.Count, 1).End(xlUp).Row
lc = w1.Cells(1, Columns.Count).End(xlToLeft).Column
For r = 2 To lr Step 1
  n = Application.CountA(w1.Range(w1.Cells(r, 8), w1.Cells(r, lc)))
  If n = 0 Then
    nr = w2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    w2.Cells(nr, 1).Resize(, 7).Value = w1.Cells(r, 1).Resize(, 7).Value
  Else
    nr = w2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    w2.Cells(nr, 1).Resize(, 7).Value = w1.Cells(r, 1).Resize(, 7).Value
    For c = 8 To lc Step 1
      If w1.Cells(r, c) <> "" Then
        nr = nr + 1
        w2.Cells(nr, 1).Resize(, 5).Value = w1.Cells(r, 1).Resize(, 5).Value
        If InStr(w1.Cells(r, c), "WKS") > 0 Then
          w2.Cells(nr, 6).Value = w1.Cells(r, c).Value
        ElseIf InStr(w1.Cells(r, c), "LCD") > 0 Then
          w2.Cells(nr, 7).Value = w1.Cells(r, c).Value
        End If
      End If
    Next c
  End If
Next r
w2.Cells.EntireColumn.AutoFit
w2.Activate
Application.ScreenUpdating = True
End Sub


Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the ReorgDataV2 macro.
 
Upvote 0
sn0w,

The same screenshots as my reply #7.

The macro code below is longer in length, but is twice as fast as macro ReorgDataV2, because it manipulates the data in memory.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code:
Option Explicit
Option Base 1
Sub ReorgDataV3()
' hiker95, 01/02/2013
' http://www.mrexcel.com/forum/excel-questions/676961-macro-search-string-insert-new-row-copy-existent-data-copy-matching-string.html
Dim w1 As Worksheet, w2 As Worksheet
Dim r As Long, lr As Long, n As Long, rr As Long, c As Long, lc As Long
Dim i As Variant, o As Variant
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Sheet2!A1)") Then Worksheets.Add(After:=w1).Name = "Sheet2"
Set w2 = Worksheets("Sheet2")
w2.UsedRange.Clear
lr = w1.Cells(Rows.Count, 1).End(xlUp).Row
lc = w1.Cells(1, Columns.Count).End(xlToLeft).Column
i = w1.Range(w1.Cells(1, 1), w1.Cells(lr, lc))
n = Application.CountA(w1.Range(w1.Cells(2, 8), w1.Cells(lr, lc)))
ReDim o(1 To UBound(i, 1) + n, 1 To 7)
o(1, 1) = i(1, 1)
o(1, 2) = i(1, 2)
o(1, 3) = i(1, 3)
o(1, 4) = i(1, 4)
o(1, 5) = i(1, 5)
o(1, 6) = i(1, 6)
o(1, 7) = i(1, 7)
rr = 1
For r = 2 To UBound(i, 1)
  n = 0
  For c = 8 To UBound(i, 2)
    If i(r, c) <> "" Then
      n = n + 1
    End If
  Next c
  If n = 0 Then
    rr = rr + 1
    o(rr, 1) = i(r, 1)
    o(rr, 2) = i(r, 2)
    o(rr, 3) = i(r, 3)
    o(rr, 4) = i(r, 4)
    o(rr, 5) = i(r, 5)
    o(rr, 6) = i(r, 6)
    o(rr, 7) = i(r, 7)
  Else
    rr = rr + 1
    o(rr, 1) = i(r, 1)
    o(rr, 2) = i(r, 2)
    o(rr, 3) = i(r, 3)
    o(rr, 4) = i(r, 4)
    o(rr, 5) = i(r, 5)
    o(rr, 6) = i(r, 6)
    o(rr, 7) = i(r, 7)
    For c = 8 To UBound(i, 2)
      If i(r, c) <> "" Then
        rr = rr + 1
        o(rr, 1) = i(r, 1)
        o(rr, 2) = i(r, 2)
        o(rr, 3) = i(r, 3)
        o(rr, 4) = i(r, 4)
        o(rr, 5) = i(r, 5)
        If InStr(i(r, c), "WKS") > 0 Then
          o(rr, 6) = i(r, c)
        ElseIf InStr(i(r, c), "LCD") > 0 Then
          o(rr, 1) = i(r, 1)
          o(rr, 2) = i(r, 2)
          o(rr, 3) = i(r, 3)
          o(rr, 4) = i(r, 4)
          o(rr, 5) = i(r, 5)
          o(rr, 7) = i(r, c)
        End If
      End If
    Next c
  End If
Next r
w2.Range("A1").Resize(UBound(o, 1), UBound(o, 2)) = o
w2.Cells.EntireColumn.AutoFit
w2.Activate
End Sub


Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the ReorgDataV3 macro.
 
Last edited:
Upvote 0
sn0w,

Thanks for the feedback.

You are very welcome. Glad I could help.

Come back anytime.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top