1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

MACRO Problems across multiple workbooks

Discussion in 'Business Applications' started by littledufour, Jan 11, 2016.

Thread Status:
Not open for further replies.
  1. littledufour

    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
     
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 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1164008

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice