MACRO Problems across multiple workbooks

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

littledufour

Thread Starter
Joined
Jan 11, 2016
Messages
1
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
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Members online

Top