Tech Support Guy banner

MACRO Problems across multiple workbooks

819 Views 0 Replies 1 Participant Last post by  littledufour
I have a Macro I'm trying to run with muliple workbooks. I have a prior weeks data and the current week's data. I want the macro to fix / format several columns and then look for new data that was not in the previous weeks' file. I'm also getting Error code 400, which I saw there was a post on it and honestly, I'm not very good with visual basic so this made no sense to me.

Here is the Macro I'm working with...

Sub BounceFeedAmanda()
'
'define variables
'
Dim wrk As Workbook
Dim ws As Worksheet
Dim oldSht As Worksheet
Dim newSht As Worksheet
Dim resultSht As Worksheet
Dim feed1 As String
Dim feed2 As String
Dim lastRow1 As Integer
Dim lastRow2 As Integer
Dim blankRow As Integer
Dim colVar(1 To 10) As Integer
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim newRng As Range
Dim oldRng As Range
Dim resRng As Range
Dim newVar As Variant
Dim oldVar As Variant
Dim resVar As Variant
Dim vArray As Variant

'
'find bounce feeds in workbook
'
k = 1
Set wrk = ActiveWorkbook

For Each ws In wrk.Worksheets
If k = 3 Then: Exit For
If ws.[a1] = "(CREATION_DATE)" And ws.[b1] = "ASIN" And ws.[c1] = "GL_PRODUCT_GROUP" Then
Select Case k
Case 1: feed1 = ws.Name
Case 2: feed2 = ws.Name
Case Else: Exit Sub
End Select
k = k + 1
End If
Next ws

If feed1 = "" And feed2 = "" Then
MsgBox ("Error: No Bounce-Feeds Found")
Exit Sub
End If

If feed1 = "" Or feed2 = "" Then
MsgBox ("Error: Only 1 Bounce-Feed Found")
Exit Sub
End If
'
'determine which feed is older and which is newer
'
lastRow1 = Sheets(feed1).Range("A" & Rows.Count).End(xlUp).Row
lastRow2 = Sheets(feed2).Range("A" & Rows.Count).End(xlUp).Row
Select Case lastRow1 > lastRow2
Case True
Set newSht = Sheets(feed1)
Set oldSht = Sheets(feed2)
Case False
Set newSht = Sheets(feed2)
Set oldSht = Sheets(feed1)
End Select

lastRow1 = newSht.Range("A" & Rows.Count).End(xlUp).Row
lastRow2 = oldSht.Range("A" & Rows.Count).End(xlUp).Row

'
'sorting the feeds by date and asin to speed up matching
'
Set newRng = newSht.Range("A1:AN" & lastRow1)
Set oldRng = oldSht.Range("A1:AN" & lastRow2)

With newSht.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1:A" & lastRow1), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("B1:B" & lastRow1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange newRng
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With oldSht.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1:A" & lastRow2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("B1:B" & lastRow2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange oldRng
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'
'rename sheets and add comparison sheet
'
newSht.Name = Format(newSht.[a2], "mm-dd")
oldSht.Name = Format(oldSht.[a2], "mm-dd")

Set resultSht = wrk.Worksheets.Add(after:=wrk.Worksheets(wrk.Worksheets.Count))
resultSht.Name = "Changes " & oldSht.Name & " to " & newSht.Name

Set resRng = resultSht.Range("A1:AN" & lastRow1)
resultSht.[a1] = "Creation Date"
resultSht.[b1] = "ASIN"
resultSht.[c1] = oldSht.Name & " Status"
resultSht.[d1] = newSht.Name & " Status"
resultSht.[e1] = "Brand"
resultSht.[f1] = "Product Description"
resultSht.[g1] = "Vendor Code"
resultSht.[h1] = "Item UPC"
resultSht.[i1] = "Vendor External ID"
'adding GTIN column
resultSht.[j1] = "GTIN"
resultSht.[k1] = "For Changes from NP/PR to OS/OB, is Case GTIN Active or Disco?"
resultSht.[l1] = "Last Order Date"
resultSht.[m1] = "If Still Active, Did AE Plan Switch to OS/OB?"
resultSht.[n1] = "If Still Active, Did Supply Team Plan Switch to OS/OB?"
resultSht.[o1] = "If No/No, Why Did Amazon Switch Item Off?"
resultSht.[p1] = "Comments"

'change j>k, k>l, l>m, m>n, n>o, o>p
'
'conduct the comparison search
'
colVar(1) = 1
colVar(2) = 2
colVar(3) = 6
colVar(4) = 6
colVar(5) = 12
colVar(6) = 10
colVar(7) = 11
colVar(8) = 13
colVar(9) = 17
colVar(10) = 14
newVar = newRng
resVar = resRng
oldVar = oldRng

blankRow = 2
i = 2
j = 2

Do While newVar(i, 1) <> oldVar(j, 1) Or i = lastRow1 / 10
For g = 1 To 9
resVar(blankRow, g) = newVar(i, colVar(g))
Next g
resVar(blankRow, 3) = "'-"
blankRow = blankRow + 1
i = i + 1
Loop

h = blankRow

For i = i To lastRow1
If j = lastRow2 Then: j = i - h
For j = j To lastRow2

If newVar(i, 2) = oldVar(j, 2) Then

If newVar(i, 6) <> oldVar(j, 6) Then
For g = 1 To 9
resVar(blankRow, g) = newVar(i, colVar(g))
Next g
resVar(blankRow, 3) = oldVar(j, colVar(3))
blankRow = blankRow + 1
j = j + 1
Exit For
End If

j = j + 1
Exit For
End If

Next j
Next i

resRng = resVar

'
'formatting
'
Columns("A:A").NumberFormat = "mm/dd/yyyy"
Columns("H:I").NumberFormat = "0"
Columns("l:l").NumberFormat = "mm/dd/yyyy"
'vendor external id column
With Range("I2", Cells(Rows.Count, "I").End(xlUp))
vArray = .Value
For lCnt = 1 To UBound(vArray, 1)
Select Case Len(Trim(vArray(lCnt, 1)))
Case 13: vArray(lCnt, 1) = "'0" & vArray(lCnt, 1)
Case 12: vArray(lCnt, 1) = "'00" & vArray(lCnt, 1)
Case 11: vArray(lCnt, 1) = "'000" & vArray(lCnt, 1)
End Select
Next lCnt
.Value = vArray
End With

'UPC column
With Range("H2", Cells(Rows.Count, "H").End(xlUp))
vArray = .Value
For lCnt = 1 To UBound(vArray, 1)
Select Case Len(Trim(vArray(lCnt, 1)))
Case 11: vArray(lCnt, 1) = "'0" & vArray(lCnt, 1)
Case 10: vArray(lCnt, 1) = "'00" & vArray(lCnt, 1)
End Select
Next lCnt
.Value = vArray
End With
'GTIN column
With Range("J2", Cells(Rows.Count, "J").End(xlUp))
vArray = .Value
For lCnt = 1 To UBound(vArray, 1)
Select Case Len(Trim(vArray(lCnt, 1)))
Case 13: vArray(lCnt, 1) = "'0" & vArray(lCnt, 1)
Case 12: vArray(lCnt, 1) = "'00" & vArray(lCnt, 1)
Case 11: vArray(lCnt, 1) = "'000" & vArray(lCnt, 1)
End Select
Next lCnt
.Value = vArray
End With

Columns("A:A").HorizontalAlignment = xlCenter
Columns("C:D").HorizontalAlignment = xlCenter
Columns("G:N").HorizontalAlignment = xlCenter
Columns("A:B").ColumnWidth = 14
Columns("C:D").ColumnWidth = 8
Columns("E:E").ColumnWidth = 16.5
Columns("F:F").ColumnWidth = 70
Columns("G:G").ColumnWidth = 8
Columns("H:H").ColumnWidth = 16
Columns("I:I").ColumnWidth = 18
Columns("J:J").ColumnWidth = 18
Columns("K:K").ColumnWidth = 25
Columns("L:L").ColumnWidth = 14
Columns("M:p").ColumnWidth = 25

With Range("A1:p1")
.Interior.Color = 49407
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.RowHeight = 30
End With

With ActiveSheet.UsedRange
.Borders.LineStyle = xlContinuous
End With

End Sub

Thank you!

Sarah
See less See more
Status
Not open for further replies.
1 - 1 of 1 Posts
1 - 1 of 1 Posts
Status
Not open for further replies.
Top