Help with Macro to move data around

[excelcheetah]

Hi,

I'm looking to move data that is placed somewhat randomly throughout a sheet in the following manner:

Mailing description
1x z
2x z
10x zzzz

Mailing description description
19xy ttttt yyyy
30 wth htw

and have it look like this:

mailing description1 description2
1x z
2x z
10x zzzz
19xy ttttt yyyy
30 wth htw

Note: the first group and the second group are in completely different columns. description can appear to the left of mailing. assume there can be an undetermined amount of descriptions and mailings spread out to different columns.

So in lehmen's terms: search for cells that CONTAIN the word "mailing" (they do not have to be an exact match of the word), copy everything beneath them until you hit a blank, paste the results into the same column in a different sheet (stacked on top of each other). Next, search for cells that CONTAIN the word "description" (they do not have to be an exact match of the word), copy everything beneath them until you hit a blank, paste to the right of the mailing name they were in the same row as, and if there were multiple descriptions continue placing further to the right of the mailing name they were in the same row as.

I have some macro experience but I have not written anything, only copied and modified so if someone could help me get started on this it would be appreciated. I do have a lot of experience writing formulas but macros are still very foreign to me.

thanks

 

[hiker95]

excelcheetah,

Welcome to the MrExcel forum.

What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples (what you have and what you expect to achieve) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

 

[excelcheetah]

Hey,

Thanks for the tip. I made a mistake in my initial description, the definition does have blanks that need to be captured, the mailing blanks should be used as the criteria for both definitions and mailings endpoint.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2			BEFORE:
3										AFTER:
4			definition ztn				mailing zyz			mailing	definition1	definition2	definition3
5			hyz				1x			1x	hyz
6			zyh				3t			3t	zyh
7			hgy				2y			2y	hgy
8										1xy	ttt	p
9										2xy	hhh	l
10										3xy	zzz	m
11	definition		definiton	defintion	mailing					5
12			p	ttt	1xy					6
13			l	hhh	2xy					7
14			m	zzz	3xy					8
15					5					9	88		9y
16					6
17					7
18					8
19	9y			88	9
Sheet1

Excel 2010

 

[hiker95]

excelcheetah,

paste the results into the same column in a different sheet (stacked on top of each other).

Can we have a screenshot of Sheet1, for 40 to 50 rows.

And, can we have a screenshot of Sheet2, with the information from Sheet1 in the correct format.

 

[hiker95]

excelcheetah,


Sample worksheets before the macro (with your raw data in Sheet1):

Excel Workbook
	A	B	C	D	E	F	G
1
2
3
4			definition ztn				mailing zyz
5			hyz				1x
6			zyh				3t
7			hgy				2y
8
9
10
11	definition		definiton	defintion	mailing
12			p	ttt	1xy
13			l	hhh	2xy
14			m	zzz	3xy
15					5
16					6
17					7
18					8
19	9y			88	9
20
Sheet1

Excel Workbook
	A	B	C	D
1
2
3
4
5
6
7
8
9
10
11
12
13
Sheet2

After the macro:

Excel Workbook
	A	B	C	D
1	mailing	definition1	definition2	definition3
2	1x	hyz
3	3t	zyh
4	2y	hgy
5	1xy	ttt	p
6	2xy	hhh	l
7	3xy	zzz	m
8	5
9	6
10	7
11	8
12	9	88		9y
13
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).


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.

Option Explicit
Sub ReorgData()
' hiker95, 07/08/2011
' http://www.mrexcel.com/forum/showthread.php?t=562799
Dim w1 As Worksheet, w2 As Worksheet
Dim SR As Long, ER As Long, NR As Long, UC As Long, NC As Long, b
Dim c As Range, firstaddress As String
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
w1.Activate
Set w2 = Worksheets("Sheet2")
w2.UsedRange.Clear
w2.Range("A1") = "mailing"
UC = w1.UsedRange.Columns.Count
With w1.UsedRange
  Set c = .Find("mail*", LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    firstaddress = c.Address
    Do
      SR = c.Row + 1
      ER = c.End(xlDown).Row
      NR = w2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      w2.Range("A" & NR).Resize(ER - SR + 1).Value = c.Offset(1).Resize(ER - SR + 1).Value
      NC = 1
      For b = UC - 1 To 1 Step -1
        If Left(Cells(c.Row, b), 3) = "def" Then
          NC = NC + 1
          w2.Cells(1, NC) = "definition"
          w2.Cells(NR, NC).Resize(ER - SR + 1).Value = Cells(c.Row, b).Offset(1).Resize(ER - SR + 1).Value
        End If
      Next b
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
End With
For b = 2 To NC Step 1
  w2.Cells(1, b) = w2.Cells(1, b) & b - 1
Next b
w2.UsedRange.Columns.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 ReorgData macro.

 

[excelcheetah]

Hey,

Thanks so much for your help it worked perfectly after I made some minor adjustments due the incomplete description I gave you. I'm working on making some tweaks due to mispellings and variations in names and I'm also going to try to add more criteria with the same situation as definition. So basically before I gave the example with one column, but i'm going to try to move around 10 or so columns.

I will post if I run into anything I can't figure out, but thanks again for the help!