PDA

View Full Version : Solved: Rearranging columns



KMoney
04-14-2010, 04:24 PM
Hello, I have spent way too much time on this and could use some help. I am simply attemtping to rearrange coulns of data using the code:

Sub Rearrange()
Columns("D:D").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

End Sub

When I step through the code it works perfectly fine. However, when I run the entire program it does not work properly. Instead of inserting Column D before Column A, Couluns A:D are simply shifted to the right one column. Its as if the Cut method is not recognized.

Thoughts?

austenr
04-14-2010, 04:49 PM
This works fine for me
Sub Rearrange()
Columns("D:D").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
End Sub

KMoney
04-14-2010, 04:54 PM
I fave figured out that it has something to do Application.Screenupdating =false. If I remove this line from my program, the code works. Any suggestions?

ZVI
04-14-2010, 05:38 PM
It works for me with Application.ScreenUpdating as well.
May be worksheet event SelectionChange triggers in your code, you can switch Application.EnableEvents = False/True
BTW - selecting is not required, try:

Sub Rearrange()
With Application
.ScreenUpdating = False
.EnableEvents = False
Columns("D").Cut
Columns("A").Insert Shift:=xlToRight
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

KMoney
04-15-2010, 07:14 AM
Thank you for your attempts to help, but EnableEvents is not the solution.

Again, here is my issue:
I have a simple piece of code:

Columns("C:C").Cut ''''' GET THIS TO WORK !!!!!!!!
Columns("A:A").Insert Shift:=xlToRight

KMoney
04-15-2010, 07:16 AM
Sorry, I accidentally sent the above reply without finishing.

The simple piece of code from above is embedded in a much larger program. Why might the code work when Screenupdating is on but it does not when Screenupdating = false????

austenr
04-15-2010, 08:44 AM
Well since your new here let me explain something to you. If you want help, demanding will get you noting but ignored. We are not paid to help you. People come here and help because they want to not because they have to.

Several people have tested what you posted and it works. However there seems to be a bigger issue. Try posting the whole macro or just post a sample workbook. No one that would help you can diagnose the problem with such little information. In the future be polite. Not demanding. Shouting (all caps and !!!!!) is the best way to get yourself ignored.

Ok I'm off my soap box now.

mdmackillop
04-15-2010, 08:59 AM
This works for me

Columns(4).Cut
Columns(1).Insert

KMoney
04-16-2010, 07:44 PM
Austenr,
I am very sorry that my previous message came off as rude or impolite. There seems to be a slight miscommunication. The all caps "GET THIS TO WORK" was not directed towards you or this website - I included the comment in my code as a reminder to myself of where the problem is. I can see how this looks bad as part of my post and I apologize. And you are right, I am new here and I have learned my lesson. I am simply looking for a bit of help and it certainly was not my intention to offend anybody.

as far as providing more information, I was hoping that there was an obvious solution that somebody with more experience than I would see right away. I was hoping to avoid posting the entire macros. But here they are ...

The program simply opens a word document, copies it into excel, and then formats the excel sheet in the sub GetUSAfile. GetUSAfile is called from Main. As you can see, i turn off Scree updating at the beginning of main. The problem code is located at near the end of GetUSA file. Again, it works fine when stepping through using the debugger and if I leave screenupdating on. I am stuck ... any help would be greatly appreciated.

Option Explicit
Sub Main()
Application.ScreenUpdating = False
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim name As String

Call GetFile(name)
Set wrdApp = CreateObject("Word.Application")
' Set wrdDoc = wrdApp.Documents.Open("C:\Program Files\Prime Analytics\ProOpticus\pldata\04_02_10.keswheat", , False)
' hardcoded directory

Set wrdDoc = wrdApp.Documents.Open(name)
wrdApp.ActiveWindow.Selection.WholeStory
wrdApp.ActiveWindow.Selection.Copy
Sheet1.Activate
ActiveSheet.Range("a1").Select
ActiveSheet.Paste
wrdApp.Application.Quit


PasteFile 'calls PasteFile()

' MsgBox "File Date: " & name
RetrieveUSAfile 'calls RetrieveUSAfile()

ActiveSheet.Range("a1").Select

Application.ScreenUpdating = True
End Sub


Sub RetrieveUSAfile()


Application.Workbooks.Open ("C:\Documents and Settings\Adam Keslosky\Desktop\TRADING\USAfile\b3145-pos")

Dim i As Integer, lastline As Integer

Workbooks("b3145-pos").Activate
ActiveSheet.Range("a:b, e:f, j:k, m:o").Delete
Columns("A:A").ColumnWidth = 10
ActiveSheet.Range("1:1").Font.Bold = True
lastline = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastline 'fixes sign on position
If Cells(i, 3) = 2 Then Cells(i, 10) = Cells(i, 4) * -1 _
Else: Cells(i, 10) = Cells(i, 4)
Next i
Range(Cells(2, 10), Cells(lastline, 10)).Cut Range("d2")
ActiveSheet.Range("c:c").Delete

For i = lastline To 2 Step -1 'deletes all non-wheat rows
If Cells(i, 5) <> "W-" Then Rows(i).Delete
Next i
ActiveSheet.Range("e:e").Delete

lastline = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastline ' fills C/P/F and Srike Columns appropriately
If Cells(i, 2) = 0 Then Cells(i, 1) = "F"
Cells(i, 2) = Cells(i, 2) * 100
Next i
Range("a:g").Copy
Workbooks("ProOptFile").Worksheets("Sheet2").Activate
Range("a1").Select
ActiveSheet.Paste
ActiveSheet.Cells(1, 1) = "C/P/F"
ActiveSheet.Cells(1, 2) = "Strike"
ActiveSheet.Cells(1, 3) = "Position"
ActiveSheet.Cells(1, 4) = "Month"
ActiveSheet.Cells(1, 5) = "Settle"
ActiveSheet.Cells(1, 6) = "t-1 Settle"
ActiveSheet.Range("e1").Select

Dim code As String

For i = 1 To lastline
code = Cells(i, 4)
If Left(code, 3) = "CAL" Then Cells(i, 4) = Right(code, Len(code) - 5)
If Left(code, 3) = "PUT" Then Cells(i, 4) = Right(code, Len(code) - 5)
Next i


Columns("e:i").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns("d:d").Select

Selection.TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True

For i = 2 To lastline
Select Case Cells(i, 4)
Case "JAN"
Cells(i, 4) = "F"
Case "FEB"
Cells(i, 4) = "G"
Case "MAR"
Cells(i, 4) = "H"
Case "APR"
Cells(i, 4) = "J"
Case "MAY"
Cells(i, 4) = "K"
Case "JUN"
Cells(i, 4) = "M"
Case "JUL"
Cells(i, 4) = "N"
Case "AUG"
Cells(i, 4) = "Q"
Case "SEP"
Cells(i, 4) = "U"
Case "OCT"
Cells(i, 4) = "V"
Case "NOV"
Cells(i, 4) = "X"
Case "DEC"
Cells(i, 4) = "Z"
Case Else
Cells(i, 4).Value = "???"
End Select
Next i
Range("f:h").Delete
Range("e1") = "Year"
Columns("g:g").Interior.ColorIndex = 16
Columns("h:h").Interior.ColorIndex = 15

' Columns("C:C").Cut ''''' PROBLEM
' Columns("A:A").Insert Shift:=xlToRight

Workbooks("b3145-pos").Activate ' closes b3145-pos file
Application.CutCopyMode = False
Range("a1").Select
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Workbooks("ProOptFile").Worksheets("Sheet1").Activate

End Sub

austenr
04-16-2010, 07:55 PM
No problem. Didn't mean to come off so harsh. Anyway, seems like a lot of this code could be simplified. It would help if you could post the word doc(s) and excel workbook in the code minus any sensitive data in order for testing to be done unless someone sees something obvious.

mdmackillop
04-17-2010, 02:53 AM
Try updating before the cut paste. You could even try forcing a recalculation and allowing any unrelated events to be carried out. With testing these extras could be deleted if not required



Application.ScreenUpdating = True
DoEvents
Calculate
Columns("C:C").Cut ''''' PROBLEM
Columns("A:A").Insert
Application.ScreenUpdating = False

KMoney
04-19-2010, 03:06 PM
How do I post entire workbooks and word docs?

mdmackillop
04-19-2010, 03:22 PM
Use Manage Attachments in the Go Advanced reply section

austenr
04-19-2010, 03:22 PM
Go to the Go Advanced button then Manage Attachments.

KMoney
04-19-2010, 04:57 PM
Okay ...
So I have attached:
1. My workbook entitled "ProOptFile" including all code
2. a word file entitled "04_16_10" (Please note the file name is date-specific"


This is how the program works:
From Main, the program opens the Word doc and pastes it into the Excel workbook. Then, Sub Pastefile() is called to perform various formatting instructions. The formatting works fine until reaching the end of Pastefile() when I attempt to rearrange the columns using Cut/Insert methods

The Problem:
Ideally, I would like to turn Screenupdating off at the beginning of Main()to optimize performance. However, the arranging of columns does not work properly with Screenupdating off. If I delete Screenupdating = false at the beginning of Main(), the formatting works fine.

Any help would be greatly appreciated!

KMoney
04-19-2010, 05:00 PM
word file attached.

Note: instructions to open file may have to be changed within code

ZVI
04-19-2010, 07:09 PM
It doesn’t matter if ScreanUpdating is True or False.
But does if some interactive message suspends the code. For example at debugging, or in case of sheet "ProOpt" was not cleared before running of the Main macro and the warning message to replace the data occurs.

But the reason of issue is in absence of releasing the memory for automation Word object variables wrdDoc and wrdApp by setting it to Nothing.

To solve the problem add two lines (in red) into the Main subroutine as follows:


Sub Main()

Application.ScreenUpdating = False

' ... Skipped part of the code ...

wrdApp.Application.Quit

Set wrdDoc = Nothing ' <-- Release the memory of the wrdDoc object variable
Set wrdApp = Nothing ' <-- Release the memory of the wrdApp object variable

'Range("a:a").Select ' <-- It's not required

PasteFile

Application.ScreenUpdating = True

End Sub
Regards,
Vladimir

KMoney
04-20-2010, 07:00 AM
That works! Thank you Vladimir! And thanks to all others that helped.