Transposing macro

[SIGE]

Hi,

I've a small problem that IMO can be easily fixed with VBA.

I've 2 datacolumns: A & B

in Column A I have different data but only 1 "key" identifier that should trigger my transpose job.
Ie. When I find eg. "SIGE" in column A (eg. A24) I would like it to transpose all data from A24 untill A34 and all data from B24 untill B34 going after the transposed data of column A. So acutally a "11x2"-range should become a "1x22"-range. (on a new sheet?)

Then the macro should go down to the next occurence of "SIGE" in column A and "transpose" the same 11x2 underneath the previous 1x22-result.

I hope some wizard can help me a hand on this one?

-There is 1 additional hitch: Can it do this procedure only when it finds exactly "SIGE" and not "SIGE 1" or "Sige"?

Desperately crossing fingers for your help, Sige

 

[venkat1926]

samle data is like thsi

Excel Workbook
	A	B
1	88	308
2	49	488
3	81	324
4	47	347
5	SIGE	272
6	59	449
7	64	446
8	26	240
9	63	328
10	80	368
11	76	449
12	69	307
13	16	359
14	86	289
15	31	305
16	83	295
17	SIGE	419
18	20	452
19	78	371
20	99	205
21	53	299
22	66	236
23	85	280
24	63	375
25	77	257
26	76	200
27	46	216
28	55	208
29	81	450
30	SIGE	443
31	12	461
32	11	486
33	19	354
34	98	300
Sheet1

try this macro and see whether you want like this (result in sheest2) data in sheet1

The string you refer to viz. SIGE take care of the spelling when you type into the input box. case does not matter because I made provision in hte macro about that.

Sub TEST()
Dim r As Range, cfind As Range
Dim x As String, add As String
x = InputBox("the string you want to find e.g. SIGE ")
Worksheets("sheet1").Select
With Columns("A:A")
Set cfind = .Cells.Find(What:=x, LookAt:=xlWhole, MatchCase:=False)
If Not cfind Is Nothing Then
add = cfind.Address
Range(cfind, cfind.Offset(10, 1)).Copy Worksheets("sheet2").Cells(Rows.Count, "A:A").End(xlUp).Offset(1, 0)
End If
Do
Set cfind = .Cells.FindNext(cfind)
If cfind Is Nothing Then Exit Do
If cfind.Address = add Then Exit Do
Range(cfind, cfind.Offset(10, 1)).Copy Worksheets("sheet2").Cells(Rows.Count, "A:A").End(xlUp).Offset(1, 0)
Loop
End With
End Sub

Sub undo()
Worksheets("sheet2").Cells.Clear
End Sub

 

[SIGE]

Hi Venkat,

Thank you for assistance. The macro is going in the right direction but it has 2 problems. Hopefully you can assist to remedy!

- The data /range is not getting "transposed",but just copied

In your example: Row1 in "sheet2" should become (over colums A / B / C /...)

SIGE / 59 / 64 / 26 / ... / 307 / 359 / 289

Row2:

SIGE / 20 / 78/ 99 / ... / 375 / 257 / 200
etc.

- For some obscure reason, the macro has skipped several good occurrences of "SIGE". I tried to figure out whether there are some invisible characters in those cells, but the "trigger cells" with "SIGE" appear to be identical...


Hope you can help me further!
Sige

 

[venkat1926]

CLEAR the cells in sheet 2 and use this modified macro

Sub TEST()
Dim r As Range, cfind As Range
Dim x As String, add As String
x = InputBox("the string you want to find e.g. SIGE ")
Worksheets("sheet1").Select
With Columns("A:A")
Set cfind = .Cells.Find(What:=x, LookAt:=xlWhole, MatchCase:=False)
If Not cfind Is Nothing Then
add = cfind.Address
Range(cfind, cfind.Offset(10, 0)).Copy
Worksheets("sheet2").Cells(Rows.Count, "A:A").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Range(cfind.Offset(0, 1), cfind.Offset(10, 1)).Copy
Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).PasteSpecial Transpose:=True
End If
Do
Set cfind = .Cells.FindNext(cfind)
If cfind Is Nothing Then Exit Do
If cfind.Address = add Then Exit Do
Range(cfind, cfind.Offset(10, 0)).Copy
Worksheets("sheet2").Cells(Rows.Count, "A:A").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Range(cfind.Offset(0, 1), cfind.Offset(10, 1)).Copy
Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).End(xlToRight).PasteSpecial Transpose:=True
Loop
End With
Application.Cursor = False
End Sub

regading sige how do you check there are unnecessary characters or spaces. there is add in "cellview" which will give all the visible and invisible characters in a cell.

http://www.cpearson.com/excel/CellView.aspx

otherwise in one case of unrecognized sige just CLEAR the cell and then retype carefully without spaces etc and check.

of course you can also use trim function if it is only case of unnecessary spaces in the beginning and / or at the end olf sige.

 

[SIGE]

Hi Venkat,

Works neatly!!! Thanks a million!
Sige