KnutsonBM
asked on
Excel Workbook with Macro's used on a sharepoint
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....
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
ASKER
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
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?
ASKER
nothing that references to anything outside the workbook, plenty of formula's referencing other cells and sheets though...........
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I appreciate your help with this!
I'll look at the code again and see if anything jumps out at me.
sdwalker