?
Solved

Excel Workbook with Macro's used on a sharepoint

Posted on 2011-09-06
6
Medium Priority
?
318 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

 
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 2000 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

Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

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

These days socially coordinated efforts have turned into a critical requirement for enterprises.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

770 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