SteveOranjin
Board Regular
- Joined
- Dec 18, 2017
- Messages
- 170
So alot of this code is comented out. So it's pretty clear what is going on.
But I'm having an error thrown in a section of the code I just added. What's confusing about it is that it worked fine in the section of the code I added when it was independent.
I have the section of the code underlined and highlighted that is throwing the error.
But I'm having an error thrown in a section of the code I just added. What's confusing about it is that it worked fine in the section of the code I added when it was independent.
I have the section of the code underlined and highlighted that is throwing the error.
Code:
Sub Import_BrandName_BrandCode2()
'we are now going to create all of our variables
Dim answer As Integer
Dim Clear_Sheet As Integer
Dim mpsLink As String
Dim brandCode As String
Dim brandName As String
Dim rngMSRPHeader As Range, rngHeaders As Range
Dim brand As String, mapPolicy As String
Dim Msg As String, Ans As Variant
Dim mp As Variant, factor As Double, aFormula As String
Dim cel As Range, rng As Range, lastCell As Range
'We're now going to disable all screen updating events.
Application.ScreenUpdating = False
'We're going to clear away any previous pulls that we've made from our API
Sheets("Import Info").Cells.Clear
'''''We're going to need to work here to hide the tab later.
Application.Goto ActiveWorkbook.Sheets("Import Info").Cells(1, 1)
'An error can, and does often occur here. So we're going to protect ourselves from it and any
'nuisances it could cause.
On Error Resume Next
'We're now going to have our VBA delete the previous query. This happens in more than one place.
ActiveWorkbook.Queries("brandDataAPI2 (2)").Delete
On Error GoTo 0
'We are setting up the query that we're going to pull the brand information from.
'' The first thing that we need in order to do that is the brand code.
brandCode = InputBox("Enter your BrandCode here")
Do While Len(brandCode) <> 3
brandCode = InputBox("Brandcodes can only contain three letters. Please try again.")
Loop
''Now we're going to set up our MPS link.
'' -- There are two parts to the link. Part one is standard and it is hardcoded.
'' -- Part 2 is the 'brandcode', it is the part that we will dynamically enter into the link on each occasion. It is the part that will change.
mpsLink = """http://cf3.myplumbingshowroom.com/scheduledScripts/brandDataAPI2.cfm?brandCode=" & brandCode & """"
Application.CutCopyMode = False ' the clause we added.
ActiveWorkbook.Queries.Add Name:="brandDataAPI2 (2)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(Web.Contents(" & mpsLink & "),[Delimiter="","", Columns=11, Encoding=65001, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""BrandName""" & _
", type text}, {"" BrandCode"", type text}, {"" BrandID"", Int64.Type}, {"" datalastUpdate"", type date}, {"" numproducts"", Int64.Type}, {""priceMethod"", type text}, {""URL"", type text}, {""showPrice"", Int64.Type}, {""MAP_YN"", Int64.Type}, {""MAP"", type text}, {""msrpNotes"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""brandDataAPI2 (2)"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [brandDataAPI2 (2)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "brandDataAPI2__2"
.Refresh BackgroundQuery:=False
End With
If IsEmpty(Range("A2")) = True Then
'We are clearing out the entry the user put in, becuase it is invalid.
Sheets("Import Info").Cells.Clear
'we're going to inform the user that the entry they put in was invalid
MsgBox ("Incorrect Entry. Not a valid Brand.")
Else
With Sheets("Data Sheet")
.Columns(1).Resize(, 2).Insert
.Range("A1:B1").Value = Array("Brandname", "Brandcode")
With .Range("C2", .Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlConstants)
.Offset(, -2).Value = Sheets("Import Info").Range("A2").Value
.Offset(, -1).Value = Sheets("Import Info").Range("B2").Value
End With
End With
End If
'we're providing the user with a choice as to wether or not they want to insert the map policy.
Msg = "Do you want to insert the Map policy into the 'data sheet' at this time?"
'the answer box with the answers 'yes' and 'no'
Ans = MsgBox(Msg, vbYesNo)
Select Case Ans
Case vbYes
Set rngHeaders = Worksheets("Data Sheet").Range("1:1") 'look in entire first row
Set rngMSRPHeader = rngHeaders.Find(what:="MSRP", After:=Cells(1, 1))
rngMSRPHeader.Offset(0, 1).EntireColumn.Insert
rngMSRPHeader.Offset(0, 1).Value = "MAPprice"
brand = Worksheets("Import Info").Range("A2")
mapPolicy = Worksheets("Import Info").Range("J2")
[COLOR=#b22222][U][I][B] MsgBox ("For Brand:" & brand & vbNewLine & "The Map Policy Is" * mapPolicy)[/B][/I][/U][/COLOR]
Set rngHeaders = Worksheets("Data Sheet").Range("1:1") 'look in entire first row
Set rngMSRPHeader = rngHeaders.Find(what:="MSRP", After:=Cells(1, 1))
rngMSRPHeader.Offset(0, 1).EntireColumn.Insert
rngMSRPHeader.Offset(0, 1).Value = "MAPprice"
brand = Worksheets("Import Info").Range("A2")
mapPolicy = Worksheets("Import Info").Range("J2")
MsgBox ("For Brand:" & brand & vbNewLine & "The Map Policy Is" & mapPolicy)
mp = InputBox("Enter Map Policy", "User Input")
If mp > 1 Then Exit Sub
factor = 1 - mp
With rngMSRPHeader.Parent
If Not rngMSRPHeader Is Nothing Then
Set lastCell = .Cells(Rows.Count, rngMSRPHeader.Column).End(xlUp)
Set rng = Range(rngMSRPHeader.Offset(1), lastCell)
For Each cel In rng
With cel.Offset(, 1)
'for formula in cell
aFormula = "=" & cel.Address(0, 0) & "*" & factor
cel.Offset(, 1).Formula = aFormula
'Enter as value (commented out)
'cel.Offset(, 1).Value = cel.Value * factor
End With
Next cel
End If
End With
Case vbNo
End Select
Sheets("Data Sheet").Select
Range("BB100").Select
ActiveWindow.SmallScroll up:=100
ActiveWindow.SmallScroll ToLeft:=44
Application.ScreenUpdating = True
End Sub
Last edited: