Shifting cells with Example for clarification-in a Macro

[ottokyleneidert]

[TABLE="class: grid, width: 1000"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[TD]N[/TD]
[TD]O[/TD]
[TD]P[/TD]
[TD]Q[/TD]
[TD]R[/TD]
[TD]S[/TD]
[TD]T[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]18[/TD]
[TD]0.19[/TD]
[TD]1.8[/TD]
[TD]1052[/TD]
[TD]0.8[/TD]
[TD]Pounds[/TD]
[TD]41890[/TD]
[TD]Hydrogen[/TD]
[TD]0.1[/TD]
[TD]Grain[/TD]
[TD]41890[/TD]
[TD]Total[/TD]
[TD]0.09[/TD]
[TD]Grain[/TD]
[TD]41890[/TD]
[TD]Wobbe[/TD]
[TD]1357[/TD]
[TD]Calc[/TD]
[TD]41890[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]64[/TD]
[TD]1.1[/TD]
[TD]0.4[/TD]
[TD]1017[/TD]
[TD][/TD]
[TD]Calc[/TD]
[TD]1337[/TD]
[TD]Comments[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]46[/TD]
[TD]0.35[/TD]
[TD]1.7[/TD]
[TD]1058[/TD]
[TD]1.01[/TD]
[TD]Pounds[/TD]
[TD]41890[/TD]
[TD]Hydrogen[/TD]
[TD]0.01[/TD]
[TD]Grain[/TD]
[TD]41890[/TD]
[TD]Wobbe[/TD]
[TD]1359[/TD]
[TD]Calc[/TD]
[TD]41890[/TD]
[TD]Comments[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Hopefully I can articulate this well. In a macro I use, .Column("X:X") .Delete Shift:x1ToLeft is used, but I've come to a point where the code keeps doing that and will wipe out the middle row due to how it was originally written. These three rows are an example, I think the easiest way would be to shift the cells out to where their counterparts are.

How could I shift cell F2 to R2? and P3 to T3? What do you guys think? And blank cells are fine.

Thank you in advance, -Otto Neidert

 

[hiker95]

ottokyleneidert,

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


If I understand you correctly, if any row contains Calc, them move Calc, and, the data to the right, in the same row, to column R = 18.

Sample raw data (columns B, C, and, D are hidden so that the data will fit in the MrExcel display area):

Excel 2007
	A	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1	18	Pounds	41890	Hydrogen	0.1	Grain	41890	Total	0.09	Grain	41890	Wobbe	1357	Calc	41890	Comments
2	64	Calc	1337	Comments
3	46	Pounds	41890	Hydrogen	0.01	Grain	41890	Wobbe	1359	Calc	41890	Comments
4
Sheet1

After the macro:

Excel 2007
	A	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1	18	0.8	Pounds	41890	Hydrogen	0.1	Grain	41890	Total	0.09	Grain	41890	Wobbe	1357	Calc	41890	Comments
2	64														Calc	1337	Comments
3	46	1.01	Pounds	41890	Hydrogen	0.01	Grain	41890	Wobbe	1359					Calc	41890	Comments
4
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
2. Open your NEW 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
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub MoveCalc_to_col_R()
' hiker95, 09/13/2014, ME805139
Dim c As Range, ca As Range, lc As Long, n As Long, myc
Application.ScreenUpdating = False
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
  Set ca = Rows(c.Row).Find("Calc", LookAt:=xlWhole)
  If Not ca Is Nothing Then
    If ca.Column <> 18 Then
      lc = Cells(c.Row, Columns.Count).End(xlToLeft).Column
      n = lc - ca.Column + 1
      myc = Range(Cells(ca.Row, ca.Column), Cells(ca.Row, lc)).Value
      Range(Cells(ca.Row, ca.Column), Cells(ca.Row, lc)).ClearContents
      Cells(ca.Row, 18).Resize(, n).Value = myc
      Set ca = Nothing
      Erase myc
    End If
  End If
Next c
Columns.AutoFit
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 MoveCalc_to_col_R macro.

 

[ottokyleneidert]

Thank you for your insight hiker95, your code would work, and maybe I will have to use it-if there is no other way. Here is some clarification:

.Columns("A:B").Delete Shift:=xlToLeft.Columns("B:D").Delete Shift:=xlToLeft
.Columns("C:E").Delete Shift:=xlToLeft
.Columns("D:F").Delete Shift:=xlToLeft
.Columns("E:G").Delete Shift:=xlToLeft
'.Range("O2").Offset(0, 4) = .Range("O2")
'.Range("P3").Offset(0, 4) = .Range("P3")
'.Columns("F:H").Delete Shift:=xlToLeft
'.Columns("G:I").Delete Shift:=xlToLeft
'.Columns("H:J").Delete Shift:=xlToLeft
'.Columns("H").Delete Shift:=xlToLeft
'.Columns("I").Delete Shift:=xlToLeft
.Columns("H").NumberFormat = "mm/dd/yy"
'.Range("G6") = .Range("E6")
.Range("E6").ClearContents

So '.Range("O2").Offset(0, 4) = .Range("O2") is something I tried to move a value over that I needed shifted over 4 just like the above example needing F2 to go to R2. The first few lines of code work, the commented stuff out is what I am still working on because if it goes that far-what I need is deleted. Any thoughts now?

 

[hiker95]

ottokyleneidert,

Thank you for your insight hiker95, your code would work, and maybe I will have to use it-if there is no other way.

Thanks for the feedback.

You are very welcome.

My macro code was written to solve your original request, your reply #1.


I do not have a clue as to what you just posted/requested?????

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.