my first project

B

bipper

New Member
Joined
Sep 13, 2005
Messages
10
First, thanks to all who view this board I have learned a great deal just by browsing this board. Through my browsing I have pieced together a user form that worked until I deleted personal.xls. I would like to get it working again without the need for personal.xls. if this is possible and you post code could you please put a few comments in it? That is my way of learning this is not for a job just personal learning experience.
Code: 
Private Sub userform_initialize()
Load BipsTool
End Sub

Private Sub Season_Click()
 Dim cb As Workbooks
  Dim pb As Workbooks
  Dim prompt, what_week
 prompt = "update what week EXAMPLE week2"
 what_week = InputBox(prompt)
 
 Set cb = ActiveWorkbook
 
Application.ScreenUpdating = False
  If what_week = "" Then
    Response = MsgBox("Need to select a sheet", vbOKOnly & vbCritical, "Selection Error")
    Exit Sub
  End If
    
strWsToOpen = Application.GetOpenFilename("Excel Files (*.xls), *.xls")

  If strWsToOpen = False Then
    Response = MsgBox("Need to select a file", vbOKOnly & vbCritical, "Selection Error")
    Exit Sub
  End If
    
 Set pb = Workbooks.Open(strWsToOpen)
    cb.Worksheets("sheet1").Range("A1:A51").Copy pb.Worksheets (what_week).Range("A1:A51")
    cb.Worksheets("sheet1").Range("D5:D51").Copy pb.Worksheets(what_week).Range("D5:D51")
    cb.Worksheets("sheet1").Range("E5:E51").Copy pb.Worksheets(what_week).Range("E5:E51")
    cb.Worksheets("sheet1").Range("G5:G51").Copy pb.Worksheets(what_week).Range("G5:G51")
    cb.Worksheets("sheet1").Range("I5:I51").Copy pb.Worksheets(what_week).Range("I5:I51")
    cb.Worksheets("sheet1").Range("K5:K51").Copy pb.Worksheets(what_week).Range("K5:K51")
    cb.Worksheets("sheet1").Range("M5:M51").Copy pb.Worksheets(what_week).Range("M5:M51")
    cb.Worksheets("sheet1").Range("O5:O51").Copy pb.Worksheets(what_week).Range("O5:O51")
    cb.Worksheets("sheet1").Range("Q5:Q51").Copy pb.Worksheets(what_week).Range("Q5:Q51")
    cb.Worksheets("sheet1").Range("S5:S51").Copy pb.Worksheets(what_week).Range("S5:S51")
    cb.Worksheets("sheet1").Range("U5:U51").Copy pb.Worksheets(what_week).Range("U5:U51")
    cb.Worksheets("sheet1").Range("W5:W51").Copy pb.Worksheets(what_week).Range("W5:W51")
    cb.Worksheets("sheet1").Range("Y5:Y51").Copy pb.Worksheets(what_week).Range("Y5:Y51")
    cb.Worksheets("sheet1").Range("AA5:AA51").Copy pb.Worksheets(what_week).Range("AA5:AA51")
    
   ' below pull updated info for next week sheet
    pb.Worksheets(what_week).Range("E58:AB59").Copy
       With cb.Worksheets("sheet1").Range("E58:AB59")
                .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       End With
    pb.Worksheets(what_week).Range("E66:AC82").Copy
       With cb.Worksheets("sheet1").Range("E66:AC82")
                .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       End With
    Application.CutCopyMode = False
    
    
 
    pb.Worksheets(what_week).Activate
 pb.Save
Unload BipsTool

End Sub

Private Sub ClearSheet_Click()
 Set cb = ActiveWorkbook

Application.ScreenUpdating = False
Dim AreYouSure As Long
AreYouSure = MsgBox("This will wipe out current sheet click OK to continue", _
vbQuestion + vbOKCancel)
Cancel = (AreYouSure = vbCancel)
If Cancel = True Then
Exit Sub
Cancel = False
End If

' Set pb = Workbooks.Open(strWsToOpen)
    cb.Worksheets("sheet1").Range("A1:A51").ClearContents
    cb.Worksheets("sheet1").Range("D5:D51").ClearContents
    cb.Worksheets("sheet1").Range("E5:E51").ClearContents
    cb.Worksheets("sheet1").Range("G5:G51").ClearContents
    cb.Worksheets("sheet1").Range("I5:I51").ClearContents
    cb.Worksheets("sheet1").Range("K5:K51").ClearContents
    cb.Worksheets("sheet1").Range("M5:M51").ClearContents
    cb.Worksheets("sheet1").Range("O5:O51").ClearContents
    cb.Worksheets("sheet1").Range("Q5:Q51").ClearContents
    cb.Worksheets("sheet1").Range("S5:S51").ClearContents
    cb.Worksheets("sheet1").Range("U5:U51").ClearContents
    cb.Worksheets("sheet1").Range("W5:W51").ClearContents
    cb.Worksheets("sheet1").Range("Y5:Y51").ClearContents
    cb.Worksheets("sheet1").Range("AA5:AA51").ClearContents
    
    
    
 'pb.Save
 
    Application.CutCopyMode = False
    cb.Worksheets("sheet1").Activate
Unload BipsTool
End Sub

Private Sub CatchAll_Click()
 Dim prompt, Whos_range
 Dim Prompt2, which_way
 Dim Prompt3, what_sheet
 Dim csh As Variant
 Dim psh As Variant
 Dim strWsToOpen As Variant
 prompt = "Update Who"
 Prompt2 = "copy to or copy from current workbook"
 Prompt3 = "what week you pullin"
 Dim cs As Worksheet 'copy sheet
 Dim ps As Worksheet 'paste sheet
 

Application.ScreenUpdating = False
 Whos_range = InputBox(prompt)
  If Whos_range = "" Then
    Response = MsgBox("Use a name so your sheet is not ruined", vbOKOnly & vbCritical, "Selection Error")
    Exit Sub
  End If
 which_way = InputBox(Prompt2)
  If which_way = "" Then
    Response = MsgBox("Use a name so your sheet is not ruined", vbOKOnly & vbCritical, "Selection Error")
    Exit Sub
  End If
 what_sheet = InputBox(Prompt3)
  If what_sheet = "" Then
    Response = MsgBox("Use a name so your sheet is not ruined", vbOKOnly & vbCritical, "Selection Error")
    Exit Sub
  End If
    
strWsToOpen = Application.GetOpenFilename("Excel Files (*.xls), *.xls")

  If strWsToOpen = False Then
    Response = MsgBox("Need to select a file", vbOKOnly & vbCritical, "Selection Error")
    Exit Sub
  End If
    
  If which_way = "from" Then
    Set cb = ActiveWorkbook
    Set csh = Sheet1
    Set pb = Workbooks.Open(strWsToOpen)
    With pb
    Set psh = pb.Worksheets(what_sheet)
    End With
    Else
    Set pb = ActiveWorkbook
    Set psh = Sheet1
    Set cb = Workbooks.Open(strWsToOpen)
      With cb
      Set csh = cb.Worksheets(what_sheet)
      End With
  End If
  
  If Whos_range = "Teams" Then
    csh.Range("A1:A51").Copy psh.Range("A1:A51")
  End If
  
  If Whos_range = "scores" Then
    csh.Range("D5:D51").Copy psh.Range("D5:D51")
  End If
  If Whos_range = "Stew" Then
    csh.Range("E5:E51").Copy psh.Range("E5:E51")
  End If
  
  If Whos_range = "John" Then
    csh.Range("G5:G51").Copy psh.Range("G5:G51")
  End If
  
  If Whos_range = "T" Then
    csh.Range("I5:I51").Copy psh.Range("I5:I51")
  End If
  
  If Whos_range = "Mark" Then
    csh.Range("K5:K51").Copy psh.Range("K5:K51")
  End If
  
  If Whos_range = "Larry" Then
    csh.Range("M5:M51").Copy psh.Range("M5:M51")
  End If
  
  If Whos_range = "Bip" Then
    csh.Range("O5:O51").Copy psh.Range("O5:O51")
  End If
  
  If Whos_range = "Ronnie" Then
    csh.Range("Q5:Q51").Copy psh.Range("Q5:Q51")
  End If
  
  If Whos_range = "Chip" Then
    csh.Range("S5:S51").Copy psh.Range("S5:S51")
  End If
  
  If Whos_range = "Lex" Then
    csh.Range("U5:U51").Copy
      With psh.Range("U5:U51")
                .PasteSpecial Paste:=xlValues
      End With
  End If
  
  If Whos_range = "Riles" Then
    csh.Range("W5:W51").Copy psh.Range("W5:W51")
  End If
  
  If Whos_range = "Kliner" Then
    csh.Range("Y5:Y51").Copy psh.Range("Y5:Y51")
   Exit Sub
  End If
  If Whos_range = "Rob" Then
    csh.Range("AA5:AA51").Copy psh.Range("AA5:AA51")
  End If
    
  If Whos_range = "all" Then
    csh.Range("A1:A51").Copy psh.Range("A1:A51")
    csh.Range("D5:D51").Copy psh.Range("D5:D51")
    csh.Range("E5:E51").Copy psh.Range("E5:E51")
    csh.Range("G5:G51").Copy psh.Range("G5:G51")
    csh.Range("I5:I51").Copy psh.Range("I5:I51")
    csh.Range("K5:K51").Copy psh.Range("K5:K51")
    csh.Range("M5:M51").Copy psh.Range("M5:M51")
    csh.Range("O5:O51").Copy psh.Range("O5:O51")
    csh.Range("Q5:Q51").Copy psh.Range("Q5:Q51")
    csh.Range("S5:S51").Copy psh.Range("S5:S51")
    csh.Range("U5:U51").Copy
      With psh.Range("U5:U51")
                .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      End With
    csh.Range("W5:W51").Copy psh.Range("W5:W51")
    csh.Range("Y5:Y51").Copy psh.Range("Y5:Y51")
    csh.Range("AA5:AA51").Copy psh.Range("AA5:AA51")
  End If
   ' below pull updated info for next week sheet
    Application.CutCopyMode = False
'    cb.Close
' pb.Save

Unload BipsTool
End Sub
This will not even compile it highlights the first pb.Worksheets "method or data member not found".
I am sure there is a simple answer but my search and find Techniques have failed me this time.
TIA
Bipper
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
bipper said:
Code: 
Dim cb As Workbooks
Dim pb As Workbooks
This will not even compile it highlights the first pb.Worksheets "method or data member not found".
Click to expand...

I could be wrong, but I think those should be:
Code: 
Dim cb As Workbook
Dim pb As Workbook

Hope that helps!
 
Upvote 0
Thanks so did I say I was a novice.

I have learned from many of your post and now ashamed of such a silly question. I only know what I have learned from this site.

Thanks again
Bipper
 
Upvote 0
You must log in or register to reply here.

Similar threads

HappyChappy
  • Solved
combining multiple cell Calculations
Replies
3
Views
210
Peter_SSs
Peter_SSs
G
  • Solved
Loop to fill array and then paste it slows down way too much
Replies
3
Views
550
GeeWhiz7
G
K
  • Question
AVERAGEIFS / SUMIF with multiple criteria
Replies
3
Views
1K
arthurbr
arthurbr
M
  • Question
How to see if my loan payment is within budget with true or false statement
Replies
6
Views
670
6StringJazzer
6StringJazzer
A
  • Question
ignore zero value when copy the firs three column & the last three columns
Replies
0
Views
274
abdo meghari
A

Forum statistics

Threads
1,219,162
Messages
6,146,660
Members
450,706
Latest member
LGVBPP

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top