Please help me Code this...

[uveenhacked]

i have tried recording a macro and assign an button for it but the code don't look good (lots of scroll and range selct) and in sometimes it end up with an error.

this is what i want to do...

-------

on button click...

save as new file name sequence number (store001.xls ...) on same folder

select sheet name "INV",

select range e3 to E65536

copy data and paste (hard code) to G3 to G65536 respectively

delete H3 - H65536 up to column AM3 to AM65536

select range G3 to G65536

copy data and paste (hard code) to H3 to H65536 respectively

select sheet name "01"

select range D3 to D65536
clear

select range H3 to H65536
clear

set all values of the range C3 to C65536 to 1

select H3

end

-------

hope you guys can help me, i am really new to this vba stuff.

Thanks in advance

 

[DominicB]

Good morning uveenhacked

Record a macro to do what you require, then go in and edit it. Make the first row (after Sub() statement):
Application.ScreenUpdating=False

and make the last line (before End Sub):
Application.ScreenUpdating=True

This should speed the macro up a great deal and stop the annoying screen flicker.

HTH

DominicB

 

[uveenhacked]

thanks dominic, it sounds good... but how can write a code to save it on another file with sequence number?

2nd, what code can i insert if my worksheet is protected with a password?

thanks for your time.

 

[DominicB]

Hi uveenhacked

Not sure what your first question refers to. Can you be a bit clearer?

2nd question, to open a password protected file via VBA use something like :

Workbooks.Open Filename:="C:\Book1.xls", Password:="test"

HTH

DominicB

 

[Zack Barresse]

ADVERTISEMENT

Hi there uveenhacked, welcome to the board!!

Maybe you can use something like this ..

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>

<SPAN style="color:#00007F">Sub</SPAN> RunFor_uveenhacked()
    <SPAN style="color:#00007F">Dim</SPAN> wsINV <SPAN style="color:#00007F">As</SPAN> Worksheet, ws01 <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> strPath <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> myNum <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> wsINV = ActiveWorkbook.Sheets("INV")
    <SPAN style="color:#00007F">Set</SPAN> ws01 = ActiveWorkbook.Sheets("01")
    strPath = ActiveWorkbook.Path
    myNum = 1 <SPAN style="color:#007F00">'sequence number, can be anything you want</SPAN>
    r = Rows.Count
    ActiveWorkbook.SaveAs strPath & "\store" & <SPAN style="color:#00007F">CStr</SPAN>(Format(myNum, "000")) & ".xls"
    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
    <SPAN style="color:#00007F">With</SPAN> wsINV
        .Unprotect "password"
        .Range("E3:E" & r).Copy .Range("G3:G" & r)
        .Range("H3:AM" & r).Delete shift:=xlLeft <SPAN style="color:#007F00">'set as desired</SPAN>
        .Range("G3:G" & r).Copy .Range("H3:H" & r)
        .Protect "password"
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
    <SPAN style="color:#00007F">With</SPAN> ws01
        .Unprotect "password"
        .Range("D3:D" & r).ClearContents
        .Range("H3:H" & r).ClearContents
        .Range("C3:C" & r).Value = 1
        .Range("H3").Select <SPAN style="color:#007F00">'???</SPAN>
        .Protect "password"
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Is this what you are looking for? I'm still not quite sure how you want to increment your number..

 

[uveenhacked]

i think firefytr, gots what i want to do but i got an error with this line...

.Range("H3:AM" & r).Delete shift:=xlLeft 'set as desired

what should i do with this?

this is the error message i got:

run-time error '1004':

delete methos of range class failed

thanks

 

[uveenhacked]

ADVERTISEMENT

ooppss... i need the copy data as hardcoded... the actual values not the formula.

 

[uveenhacked]

this is the macro i've recorded, this should work fine but in some cases, it dont clear all cells that i want to clear, i think it's because of the way i select it?


Sub reset_data()

'
' reset_data Macro
' Macro recorded 11/30/2005 by pc017
'

'
Application.ScreenUpdating = False
Sheets("Inv").Select
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H3:AM3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("G3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("H3").Select
ActiveSheet.Paste
Sheets("01").Select
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Selection.End(xlUp).Select
Range("H3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("D3").Select
Application.ScreenUpdating = True
End Sub

wish anybody could help me, i think firefytr would work with just some adjustment, the problem i got from it is it copy the formula, not the actual value.

 

[Zack Barresse]

Oh, that should be xlToLeft, not xlLeft. I always forget that, sorry.

 

[uveenhacked]

hello guys, this is my final code... thanks for the help, i've recorded a macro and edit it.

i have a little prob, i want to put protection on it, how can i insert it in my codes?

thanks again..



Sub reset_data()

msg = "This will reset all data entry made, are you sure you want to continue?"
If MsgBox(msg, vbYesNo, "Sumagot ka!") = vbYes Then

'save document before anything else
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveWorkbook.SaveAs ActiveWorkbook.FullName

'create new file
strPath = ActiveWorkbook.Path
fname = ActiveWorkbook.FullName
fname = Mid(fname, Len(fname) - 6, 3)
fname = Format(fname + 1, "000")
newfilename = strPath & "\store" & fname & ".xls"
ActiveWorkbook.SaveAs newfilename

'reset data
Application.ScreenUpdating = False
Sheets("Inv").Select
Range("E3:E65536").Select
Selection.Copy
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H3:AM65536").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("G3:G65536").Select
Selection.Cut
Range("H3").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("01").Select
Range("D3:D65536").Select
Selection.ClearContents
Range("H3:H65536").Select
Selection.ClearContents
Range("C3:C65536").Value = 1
Sheets("summary").Select
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Sheets("01").Select
ActiveWindow.SmallScroll Down:=-65536
Range("D3").Select
Application.ScreenUpdating = True
Else:
MsgBox "Mag isip muna bago pumindot ha...", vbInformation, "Naman!!!"
End If
End Sub