KJH
03-02-2018, 10:14 AM
Hello,
I'm running just a simple batch processing macro to prepare an alternative sheet which will be used for a mass upload into my database. The process is simple, I want the macro to evaluate the string inputed by my analysts and assign variables several set values based off of the input. Using those variables I create the new sheet. Simple enough, unless I get a VBA error code 400 which gives zero explanation as to why/what is the error. Please help, amateur hour needs to end!!!
Sub WeeklyResearch_MassUpload_Format()
Dim issuetype As String
Dim status As String
Dim action As String
Dim RecommendedAction As String
Dim WRrowcount As Long
Dim MUrownum As Long
Dim SKU As Long
Dim PartnerName As String
Dim partnernum As Long
Dim pqass As String 'lol
Dim issrcgnz As String
Dim logid As Integer
Dim opendate As String 'Just for testing purposes, later, change to date.
Dim analysis As String
Dim WR As Worksheet
Dim massupload_print As Worksheet
Set WR = Sheets("Weekly_Research")
Set massupload_print = Sheets("MassUpload_Print")
WR.Cells(1, 6).Activate
ActiveCell.End(xlDown).Activate
MUrownum = 1
logid = 5
opendate = "February 26th, 2016"
issrcgnz = "Weekly Workbooks"
Application.ScreenUpdating = False
WRrowcount = WR.Range("C1").CurrentRegion.Rows.Count
'Loop Processing
Do While ActiveCell.Row < (WRrowcount + 1)
'Filter out Good, Watch, Physical Audit from processing
Do While (InStr(1, ActiveCell, "Good", vbTextCompare) > 0 Or InStr(1, ActiveCell, "Watch", vbTextCompare) > 0 Or InStr(1, ActiveCell, "Physical", vbTextCompare) > 0)
If InStr(1, ActiveCell, "Good", vbTextCompare) > 0 Then
ActiveCell.Offset(1, 0).Activate
If IsEmpty(ActiveCell) Then
ActiveCell.End(xlDown).Activate
End If
ElseIf InStr(1, ActiveCell, "Watch", vbTextCompare) > 0 Then
ActiveCell.Offset(1, 0).Activate
If IsEmpty(ActiveCell) Then
ActiveCell.End(xlDown).Activate
End If
ElseIf InStr(1, ActiveCell, "Physical Audit", vbTextCompare) > 0 Then
ActiveCell.Offset(1, 0).Activate
If IsEmpty(ActiveCell) Then
ActiveCell.End(xlDown).Activate
End If
End If
Loop
'Defining IssueType
If Left(ActiveCell, 2) = "AR" Then
issuetype = "At Risk"
ElseIf Left(ActiveCell, 2) = "HR" Then
issuetype = "High Risk"
ElseIf Left(ActiveCell, 2) = "RH" Then
issuetype = "Return Hold Report"
ElseIf Left(ActiveCell, 2) = "Co" Then
issuetype = "Item Enhancement"
ElseIf Left(ActiveCell, 2) = "Im" Then
issuetype = "Item Enhancement"
End If
'Defining Status
If issuetype = "At Risk" Then
status = "Open"
ElseIf issuetype = "High Risk" Then
status = "Open"
ElseIf issuetype = "Item Enhancement" Then
status = "Open"
ElseIf issuetype = "Return Hold Report" Then
status = "Return Hold"
End If
'Defining Recommended Action
If InStr(1, ActiveCell, "Packaging Issue", vbTextCompare) > 0 Then
RecommendedAction = "Please review and update packaging of this product. Please send images of packaging improvements or a new drop test report."
ElseIf InStr(1, ActiveCell, "Defective Item", vbTextCompare) > 0 Then
RecommendedAction = "Please perform inventory check to remove defective product. Please advise once this has been done."
ElseIf InStr(1, ActiveCell, "Received Wrong Item", vbTextCompare) > 0 Then
RecommendedAction = "Please check UPCs to ensure that they match SKU number(s). Please check inventory to ensure that product is labeled correctly."
ElseIf InStr(1, ActiveCell, "Missing Parts", vbTextCompare) > 0 Then
RecommendedAction = "Please perform inventory check to ensure that product arrives complete. Please advise once this has been done."
ElseIf InStr(1, ActiveCell, "Copy Issue", vbTextCompare) > 0 Then
RecommendedAction = analysis
ElseIf InStr(1, ActiveCell, "Image Issue", vbTextCompare) > 0 Then
RecommendedAction = analysis
End If
'Reformatting the Action
If InStr(1, ActiveCell, "Packaging Issue", vbTextCompare) > 0 Then
action = "Packaging Issue"
ElseIf InStr(1, ActiveCell, "Defective Item", vbTextCompare) > 0 Then
action = "Defective Item"
ElseIf InStr(1, ActiveCell, "Received Wrong Item", vbTextCompare) > 0 Then
action = "Received Wrong Item"
ElseIf InStr(1, ActiveCell, "Missing Parts", vbTextCompare) > 0 Then
action = "Missing Parts"
End If
MUrownum = MUrownum + 1
SKU = ActiveCell.Offset(0, -3)
pqass = ActiveCell.Offset(0, 6)
PartnerName = ActiveCell.Offset(0, 7)
partnernum = ActiveCell.Offset(0, 8)
analysis = ActiveCell.Offset(0, 1)
ActiveCell = action
ActiveCell.Offset(0, -2) = issuetype
ActiveCell.Offset(0, -1) = status
ActiveCell.Offset(0, 2) = RecommendedAction
massupload_print.Cells(MUrownum, 1) = logid
massupload_print.Cells(MUrownum, 2) = opendate
massupload_print.Cells(MUrownum, 3) = SKU
massupload_print.Cells(MUrownum, 4) = status
massupload_print.Cells(MUrownum, 5) = issuetype
massupload_print.Cells(MUrownum, 6) = pqass
massupload_print.Cells(MUrownum, 7) = issrcgnz
massupload_print.Cells(MUrownum, 8) = action
massupload_print.Cells(MUrownum, 9) = analysis
massupload_print.Cells(MUrownum, 10) = RecommendedAction
massupload_print.Cells(MUrownum, 11) = partnernum
massupload_print.Cells(MUrownum, 12) = PartnerName
'navigation through workbook...
If ActiveCell.Offset(1, 0) <> Empty Then
ActiveCell.Offset(1, 0).Activate
ElseIf ActiveCell.End(xlDown).Row < (WRrowcount + 1) Then
ActiveCell.End(xlDown).Activate
End If
If ActiveCell.Row > (WRrowcount + 1) Then
Exit Do
End If
Loop
Application.ScreenUpdating = True
WR.Cells(1, 1).Activate
'MsgBox ("Thanks for playing, have a nice day")
End Sub
I'm running just a simple batch processing macro to prepare an alternative sheet which will be used for a mass upload into my database. The process is simple, I want the macro to evaluate the string inputed by my analysts and assign variables several set values based off of the input. Using those variables I create the new sheet. Simple enough, unless I get a VBA error code 400 which gives zero explanation as to why/what is the error. Please help, amateur hour needs to end!!!
Sub WeeklyResearch_MassUpload_Format()
Dim issuetype As String
Dim status As String
Dim action As String
Dim RecommendedAction As String
Dim WRrowcount As Long
Dim MUrownum As Long
Dim SKU As Long
Dim PartnerName As String
Dim partnernum As Long
Dim pqass As String 'lol
Dim issrcgnz As String
Dim logid As Integer
Dim opendate As String 'Just for testing purposes, later, change to date.
Dim analysis As String
Dim WR As Worksheet
Dim massupload_print As Worksheet
Set WR = Sheets("Weekly_Research")
Set massupload_print = Sheets("MassUpload_Print")
WR.Cells(1, 6).Activate
ActiveCell.End(xlDown).Activate
MUrownum = 1
logid = 5
opendate = "February 26th, 2016"
issrcgnz = "Weekly Workbooks"
Application.ScreenUpdating = False
WRrowcount = WR.Range("C1").CurrentRegion.Rows.Count
'Loop Processing
Do While ActiveCell.Row < (WRrowcount + 1)
'Filter out Good, Watch, Physical Audit from processing
Do While (InStr(1, ActiveCell, "Good", vbTextCompare) > 0 Or InStr(1, ActiveCell, "Watch", vbTextCompare) > 0 Or InStr(1, ActiveCell, "Physical", vbTextCompare) > 0)
If InStr(1, ActiveCell, "Good", vbTextCompare) > 0 Then
ActiveCell.Offset(1, 0).Activate
If IsEmpty(ActiveCell) Then
ActiveCell.End(xlDown).Activate
End If
ElseIf InStr(1, ActiveCell, "Watch", vbTextCompare) > 0 Then
ActiveCell.Offset(1, 0).Activate
If IsEmpty(ActiveCell) Then
ActiveCell.End(xlDown).Activate
End If
ElseIf InStr(1, ActiveCell, "Physical Audit", vbTextCompare) > 0 Then
ActiveCell.Offset(1, 0).Activate
If IsEmpty(ActiveCell) Then
ActiveCell.End(xlDown).Activate
End If
End If
Loop
'Defining IssueType
If Left(ActiveCell, 2) = "AR" Then
issuetype = "At Risk"
ElseIf Left(ActiveCell, 2) = "HR" Then
issuetype = "High Risk"
ElseIf Left(ActiveCell, 2) = "RH" Then
issuetype = "Return Hold Report"
ElseIf Left(ActiveCell, 2) = "Co" Then
issuetype = "Item Enhancement"
ElseIf Left(ActiveCell, 2) = "Im" Then
issuetype = "Item Enhancement"
End If
'Defining Status
If issuetype = "At Risk" Then
status = "Open"
ElseIf issuetype = "High Risk" Then
status = "Open"
ElseIf issuetype = "Item Enhancement" Then
status = "Open"
ElseIf issuetype = "Return Hold Report" Then
status = "Return Hold"
End If
'Defining Recommended Action
If InStr(1, ActiveCell, "Packaging Issue", vbTextCompare) > 0 Then
RecommendedAction = "Please review and update packaging of this product. Please send images of packaging improvements or a new drop test report."
ElseIf InStr(1, ActiveCell, "Defective Item", vbTextCompare) > 0 Then
RecommendedAction = "Please perform inventory check to remove defective product. Please advise once this has been done."
ElseIf InStr(1, ActiveCell, "Received Wrong Item", vbTextCompare) > 0 Then
RecommendedAction = "Please check UPCs to ensure that they match SKU number(s). Please check inventory to ensure that product is labeled correctly."
ElseIf InStr(1, ActiveCell, "Missing Parts", vbTextCompare) > 0 Then
RecommendedAction = "Please perform inventory check to ensure that product arrives complete. Please advise once this has been done."
ElseIf InStr(1, ActiveCell, "Copy Issue", vbTextCompare) > 0 Then
RecommendedAction = analysis
ElseIf InStr(1, ActiveCell, "Image Issue", vbTextCompare) > 0 Then
RecommendedAction = analysis
End If
'Reformatting the Action
If InStr(1, ActiveCell, "Packaging Issue", vbTextCompare) > 0 Then
action = "Packaging Issue"
ElseIf InStr(1, ActiveCell, "Defective Item", vbTextCompare) > 0 Then
action = "Defective Item"
ElseIf InStr(1, ActiveCell, "Received Wrong Item", vbTextCompare) > 0 Then
action = "Received Wrong Item"
ElseIf InStr(1, ActiveCell, "Missing Parts", vbTextCompare) > 0 Then
action = "Missing Parts"
End If
MUrownum = MUrownum + 1
SKU = ActiveCell.Offset(0, -3)
pqass = ActiveCell.Offset(0, 6)
PartnerName = ActiveCell.Offset(0, 7)
partnernum = ActiveCell.Offset(0, 8)
analysis = ActiveCell.Offset(0, 1)
ActiveCell = action
ActiveCell.Offset(0, -2) = issuetype
ActiveCell.Offset(0, -1) = status
ActiveCell.Offset(0, 2) = RecommendedAction
massupload_print.Cells(MUrownum, 1) = logid
massupload_print.Cells(MUrownum, 2) = opendate
massupload_print.Cells(MUrownum, 3) = SKU
massupload_print.Cells(MUrownum, 4) = status
massupload_print.Cells(MUrownum, 5) = issuetype
massupload_print.Cells(MUrownum, 6) = pqass
massupload_print.Cells(MUrownum, 7) = issrcgnz
massupload_print.Cells(MUrownum, 8) = action
massupload_print.Cells(MUrownum, 9) = analysis
massupload_print.Cells(MUrownum, 10) = RecommendedAction
massupload_print.Cells(MUrownum, 11) = partnernum
massupload_print.Cells(MUrownum, 12) = PartnerName
'navigation through workbook...
If ActiveCell.Offset(1, 0) <> Empty Then
ActiveCell.Offset(1, 0).Activate
ElseIf ActiveCell.End(xlDown).Row < (WRrowcount + 1) Then
ActiveCell.End(xlDown).Activate
End If
If ActiveCell.Row > (WRrowcount + 1) Then
Exit Do
End If
Loop
Application.ScreenUpdating = True
WR.Cells(1, 1).Activate
'MsgBox ("Thanks for playing, have a nice day")
End Sub