Solved

Excel Workbook with Macro's used on a sharepoint

Posted on 2011-09-06
6
298 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
U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

 
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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Copy all Sheet1-Sheets into a newly created workbook using VBA 8 33
ADD New Entries 7 16
Excel copy picture into Outlook email 7 45
Auto populate in Cascade dropdown 3 27
A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

920 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now