Solved

Excel Workbook with Macro's used on a sharepoint

Posted on 2011-09-06
6
304 Views
Last Modified: 2012-06-21
are there any known issues with using a workbook off of sharepoint that has vba on it?

I am getting a pop up asking for a user name and a password when i run this on other peoples computers when i try to run the code........the code is below for you to look at..

I apologize for the crudeness of the code but it was slapped together hastily...

there are two portions, one that imports data from another sheet, and one that is  on a worksheet module to make changes as certain cells are changed....
Sub UpdateThisStuff()

Dim r As Range
Dim q As Range
Dim v As Integer
Dim LastR
Dim Z As Integer
Dim xCell As Range
Dim InitialCount As Integer
Dim NewCount As Integer
Dim u As Integer
Dim RightHere As Integer



Application.ScreenUpdating = False

'Delete Useless Crap

If Sheets("PasteNew").Cells(1, 1).Value <> "BOEING PROPRIETARY" Then

MsgBox ("YOU PASTED THE ALL SOI'S REPORT INCORRECTLY!!!!!!!........'Never under any circumstances take a sleeping pill and a laxative on the same night'")

Exit Sub

Else

End If

InitialCount = Application.CountA(Sheets("Master List").Range("D:D"))

Sheets("PasteNew").Rows("1:10").Delete

Skip1:

'text to columns
Sheets("PasteNew").Select
    Columns("M:M").Select
    
    Selection.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 9), Array(3, 9)), TrailingMinusNumbers:=True

'Update Planned Start Dates, Work Center, Control Station

    With ThisWorkbook.Worksheets("Master List")
    
        LastR = .Cells(.Rows.Count, "d").End(xlUp).Row
        
        .Range("b2:b" & LastR).Formula = "=INDEX(PasteNew!B:B,MATCH(D2,PasteNew!F:F,0))"
        
        .Range("b2:b" & LastR).Value = .Range("b2:b" & LastR).Value
        
        .Range("c2:c" & LastR).Formula = "=INDEX(PasteNew!D:D,MATCH(D2,PasteNew!F:F,0))"
        
        .Range("c2:c" & LastR).Value = .Range("c2:c" & LastR).Value
        
        .Range("i2:i" & LastR).Formula = "=INDEX(PasteNew!M:M,MATCH(D2,PasteNew!F:F,0))"
        
        .Range("i2:i" & LastR).Value = .Range("i2:i" & LastR).Value
        
    End With

'Fill Formula

Z = Application.CountA(Sheets("Master List").Range("D:D"))

v = Sheets("PasteNew").UsedRange.Rows.Count

    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
        Range("A2").FormulaR1C1 = _
        "=COUNTIFS(R[0]C[2],""5*"",R[0]C[10],""<>COMPLETE"",R[0]C[10],""<>CANCELLED"",R[0]C[10],""<>UNRELEASED"",R[0]C[6],""FAD*"")"
    Range("A2").AutoFill Destination:=Range("A2:A" & v)
    
        Columns("A:A").Copy
    Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Add New Lines

Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long



    Sheets("PasteNew").Select
        Firstrow = Sheets("PasteNew").UsedRange.Cells(1).Row
        Lastrow = Sheets("PasteNew").UsedRange.Rows(Sheets("PasteNew").UsedRange.Rows.Count).Row
        For Lrow = Lastrow To Firstrow Step -1
            With Sheets("PasteNew").Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Value = 0 Then .EntireRow.Delete
                End If
            End With
        Next Lrow


'Add Missing Sheets

    Dim SourceWs As Worksheet, DestWs As Worksheet
    Dim rng As Range, cel As Range
    Dim LastRo As Long
    Dim DestR As Long

    Set SourceWs = ThisWorkbook.Worksheets("PasteNew")
    Set DestWs = ThisWorkbook.Worksheets("Master List")

    With SourceWs
        LastRo = .Cells(.Rows.Count, "g").End(xlUp).Row
        Set rng = .Range("g2:g" & LastRo)
    End With

    With DestWs
        DestR = .Cells(.Rows.Count, "d").End(xlUp).Row
        For Each cel In rng.Cells
            If Application.CountIf(.Range("'" & .Name & "'!d2:d" & DestR), cel.Value) = 0 Then
                DestR = DestR + 1
                .Cells(DestR, "a") = cel.Offset(0, -5)
                .Cells(DestR, "b") = cel.Offset(0, -4)
                .Cells(DestR, "c") = cel.Offset(0, -2)
                .Cells(DestR, "d") = cel
                .Cells(DestR, "e") = cel.Offset(0, 1)
                .Cells(DestR, "h") = cel.Offset(0, 4)
                .Cells(DestR, "i") = cel.Offset(0, 7)
            End If
        Next
    End With

   
   Sheets("Master List").Select
        Range(Cells(Z, 2), Cells(DestR, 2)).Select
        For Each xCell In Selection
        xCell.Value = CDec(xCell.Value)
        Next xCell
        
'Clear Paste Sheet

Sheets("PasteNew").UsedRange.ClearContents

NewCount = Application.CountA(Sheets("Master List").Range("D:D"))

u = NewCount - InitialCount


RightHere = Sheets("Charts").Range("C1").End(xlDown).Offset(1, 0).Row

Sheets("Charts").Cells(RightHere, 3).Value = u


MsgBox ("Congratulations, you have just added more work to this already mundane task." & Chr$(13) & "Previous count: " & InitialCount & Chr$(13) & "New Count: " & NewCount & Chr$(13) & "For a grand total of " & u & " more SOIs to Review")


Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 12 Then GoTo Check6
r = Target.Row
Cells(r, 16) = Date

If Cells(r, 12).Value = "" Then
    Cells(r, 16) = ""
End If

Exit Sub

Check6:

If Target.Column <> 6 Then GoTo Check12
r = Target.Row
Cells(r, 17) = Date

If Cells(r, 6).Value = "" Then
    Cells(r, 17) = ""
    
End If
    
If Target.Column <> 6 Then GoTo Check12
r = Target.Row
If Len(Cells(r, 6).Value) = 6 Or Cells(r, 6).Value = "" Or Cells(r, 6).Value = "No Parts RQD" Or Cells(r, 13).Value = "Parts Available" Then Exit Sub
    MsgBox ("Not Valid Outbound Order Number")
    Cells(r, 6) = ""

Exit Sub



Check12:

If Target.Column <> 13 Then GoTo Check14
r = Target.Row
If Len(Cells(r, 13).Value) = 7 Or Cells(r, 13).Value = "" Or Cells(r, 13).Value = "NP" Or Cells(r, 13).Value = "NAR" Then Exit Sub
    MsgBox ("Not Valid SRR Number")
    Cells(r, 13) = ""

Exit Sub

Check14:

If Target.Column <> 15 Then Exit Sub
r = Target.Row
If Len(Cells(r, 15).Value) = 6 Or Cells(r, 15).Value = "" Or Cells(r, 15).Value = "NP" Or Cells(r, 15).Value = "NAR" Then Exit Sub
    MsgBox ("Not Valid ARF Number")
    Cells(r, 15) = ""

End Sub

Open in new window

0
Comment
Question by:KnutsonBM
  • 3
  • 3
6 Comments
 
LVL 12

Expert Comment

by:sdwalker
ID: 36490827
I don't see anything wrong with the code you posted, but FYI, I have not had issues sharing an Excel 2007 workbook with code on a Sharepoint site.

I'll look at the code again and see if anything jumps out at me.

sdwalker
0
 
LVL 6

Author Comment

by:KnutsonBM
ID: 36490850
another odd thing here, it appears that if i go into the VB Editor and run it from there, rather than using the button, then it works, but if i use the button it fails
0
 
LVL 12

Expert Comment

by:sdwalker
ID: 36490874
OK that IS strange.  I have had this issue before, but I think it's usually been related to a bad reference.  Do you have any references in your spreadsheet or code?
0
The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

 
LVL 6

Author Comment

by:KnutsonBM
ID: 36490906
nothing that references to anything outside the workbook, plenty of formula's referencing other cells and sheets though...........

0
 
LVL 12

Accepted Solution

by:
sdwalker earned 500 total points
ID: 36490939
No - I just meant outside references.  One thing you could try (if the spreadsheet is not too large) is copying and pasting everything to a new spreadsheet and uploading that to the sharepoint site.  If you had 20 tabs and 5 modules it might not be fun, but if it's rather small, it might be worth a shot.  I've fixed a couple of spreadsheets this way before.

I'm sorry I'm not offering you anything more definitive.

sdwalker
0
 
LVL 6

Author Closing Comment

by:KnutsonBM
ID: 36502743
I appreciate your help with this!
0

Featured Post

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question