View Full Version : Help with Streamlining VB Code


sphynx
02-02-2011, 05:15 AM
Public Sub PlannedManufactureCsvUpload() 'UPLOAD PLANNED MANUFACTURE TO COGNOS CSV

If MsgBox("Upload Planning Data to Cognos" & vbCrLf & vbLf & "This function will take 3 - 4 min depending on your PC ", _
vbYesNo, "Cognos Planning Data Upload ") = vbNo Then MsgFlag = 1 'MESSAGE BOX UPLOAD YES/NO

If MsgFlag = 1 Then Exit Sub

Application.ScreenUpdating = False 'SWITCH OFF SCREEN UPDATE
Application.Calculation = xlManual 'SWITCH OFF CALCULATIONS

Sheets("CognosCSV").Select
Application.ScreenUpdating = False 'SWITCH OFF SCREEN UPDATE
Sheets("CognosCSV").Range("c3:IV1000").Value = "" 'CLEAR OLD DATA FROM "CognosCSV" SHEET
Sheets("CognosCSV").Range("b3:b3000").Value = Sheets("DATA").Range("A1:A1000").Value 'IMPORT SKU CODES FROM "DATA" SHEET
Sheets("CognosCSV").Range("C3:IE3").Value = Sheets("Planning Board").Range("T9:IV9").Value 'IMPORT MANUFACTURING DATES FROM "Planning Board" SHEET

Range("C4:IE1002").Value = "=CONCATENATE(R1C3,R2C,RC1)" 'CONCATENATE CELL REF TO STRING
Range("C4:IE1002").Value = Range("C4:IE1002").Value 'REPLACE FORMULAS WITH STATIC VALUES

Range("C4:IE1002").Select 'CONVERT STRING TO LOOKUP PLANNED VALUES
Selection.Replace What:="*='Planning ", Replacement:="='Planning ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("C4:IE1002").Value = Range("C4:IE1002").Value 'REPLACE FORMULAS WITH STATIC VALUES

Range("B4:IE1003").Select 'SELECT DATA
Selection.NumberFormat = "0.00" 'REFORMAT TO NUMBER AS TO 2 DECIMAL PLACES

Sheets("CognosCSV").Select 'COPY COGNOS CSV
Sheets("CognosCSV").Copy 'CREATE NEW SHEET

Application.DisplayAlerts = False 'DISABLE WARNINGS
ActiveWorkbook.SaveAs Filename:="\\kates32\cognos\CSV Files\Planner_Data\Planned_Manufacture.csv" 'SAVE VALUES TO CSV FILE
Application.DisplayAlerts = True 'ENABLE WARNINGS
Windows("Planned_Manufacture.csv").Activate 'SET FOCUS TO CSV
ActiveWorkbook.Close 'CLOSE CSV
Sheets("Planning Board").Select 'SELECT PLANNING BOARD

Application.Calculation = xlAutomatic 'SWITCH ON CALCULATIONS
Application.ScreenUpdating = True 'SWITCH ON SCREEN UPDATE

End Sub

The Module is hanging @ Line 12 & 13 (CONCATENATE) & @ Lines 23 - 28 where it is Copying and transfering data

Any help in making this more efficient would be appreciated

JamesMcS
02-02-2011, 05:53 AM
Not used Excel VBa much, but is .value a valid property of the range object? By that I mean are you going to have to create a loop to individually populate all the cells in that range?

And I see you're using R1C1 system to select values in that line. Have you set Excel to use that system of reference? You've got R1C3,R2C,RC1 so no column ref in the second but and no row ref in the third. Will that work?

Forgive me if I'm asking stupid questions, just guessing really.....

Brianwarnock
02-02-2011, 05:59 AM
The concatenate looks ok and works fine on a smaller test sample I set up. Of course I do not have your workbook so cannot see where yours is hanging.

as for the
Sheets("CognosCSV").Select 'COPY COGNOS CSV
Sheets("CognosCSV").Copy

The select is not needed , the copy will copy the sheet to a new workbook that will automatically be created. If you want a new sheet in the same workbook use the Before or After keyword.

Where does it actually hang.

Brian

Brianwarnock
02-02-2011, 06:02 AM
Not used Excel VBa much, but is .value a valid property of the range object? By that I mean are you going to have to create a loop to individually populate all the cells in that range?

And I see you're using R1C1 system to select values in that line. Have you set Excel to use that system of reference? You've got R1C3,R2C,RC1 so no column ref in the second but and no row ref in the third. Will that work?

Forgive me if I'm asking stupid questions, just guessing really.....

There is no such thing as a stupid question, ignorance is not a crime, we all are ignorant of many things.

It is all fine the lack of a C or R ref says "current Column or Row"
Oh and no he doesn't need a loop.

Brian

sphynx
02-02-2011, 06:22 AM
I kind of expected the concatenate to hang as it fills approx 24,000 cells.

It is the Opening, Transfering and saving of data to the external CSV that seems to be the problem.

I did try something in this vain, but couldnt get it to work

Windows(Win1).sheets(Sheet1).Range(A1:DE1000).valu e =Windows(Win2).sheets(Sheet1).Range(A1:DE1000).val ue

I this possible in any way??

Brianwarnock
02-02-2011, 06:35 AM
Never having done it it is new to me also, so no immediate help to you.

as for the fact that its 24000 cells , my reaction is so what. Do you know how many it had done?

Brian

Brianwarnock
02-02-2011, 06:51 AM
Ok created more data to recreate yours, it is the conversion from formula to static values that takes a long time, but it gets there.

Brian

Ps my old machine, 2002, is slow anyway.

Brianwarnock
02-02-2011, 07:45 AM
Ok had a bit of a play

the Sheets("sheetname").Copy creates a workbook called Book1 with one sheet of sheetname, but does not save it, so you need to change your saveas from
Activeworkbook.saveas.....
to
Workbooks("Book1").saveas....


Brian

sphynx
02-03-2011, 06:33 AM
I implimented the last change you suggested to the save function and also rejigged the re-calculation points in my modules.

I have managed to get the module to run 3 times for diffrenet data sets in just under 2 minutes, so I am happy.

Thanks for your help

Brianwarnock
02-03-2011, 06:50 AM
Glad its all ok, there I've typed ok again, didn't realise how often I typed it until I reread my posts. :o

BTW I loved the full documentation, I wish I was that organized.

Brian