StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>The are a number of problems with this code</p> <ol> <li>You are not qualifying all your references to <code>Range</code>'s and <code>Cells</code>. This results in reference tot the active sheet, not always what you want.</li> <li>You are copying formulas from your source sheets, which results in incorrect calculations. probably want to copy values instead</li> <li>Not all your variables are defined or set</li> <li>Your indexing into <code>wData</code> when copying from <code>FBL5N</code> overwrites the headers</li> <li>Your indexing into <code>wData</code> when copying from <code>Line Item Detail</code> seems wrong (overrights first data set</li> </ol> <p>Here's your code refactored to correct these errors (note some code is commented out where it makes no sence)</p> <pre><code>Option Explicit Sub AR_Request_Populate() ' ' ' WORKING ' TODO: Pull in sales info and pricing folder, Finsih off Repay ' ' 'AR_Request_Populate Macro ' Refreshes Pivot Tables and fills out the AR Request sheet. Ends with copy,paste, special: values. ' ' Keyboard Shortcut: None ' Dim wb As Workbook Dim wFBL5N As Worksheet Dim wLID As Worksheet Dim wDATA As Worksheet Dim ws As Worksheet Dim iEndcol As Integer Dim lEndRowA As Long, lEndRowB As Long Dim i As Integer, j As Integer Dim y As Integer, x As Integer Dim v On Error Resume Next Set wb = ActiveWorkbook Set wLID = wb.Sheets("Line Item Detail") Set wFBL5N = wb.Sheets("FBL5N") If wFBL5N Is Nothing And wLID Is Nothing Then GoTo 102 'On Error GoTo 101 On Error GoTo 0 'Application.ScreenUpdating = False wb.Sheets("wDATA").Visible = True Set wDATA = wb.Sheets("wDATA") ' Let's make a data sheet.... ' DO NOT REDEFINE lEndrowA until all data is moved If Not wFBL5N Is Nothing Then With wFBL5N lEndRowA = .Cells(.Rows.Count, 1).End(xlUp).Row iEndcol = .Cells(1, .Columns.Count).End(xlToLeft).Column wFBL5N.Copy _ after:=wb.Sheets("FBL5N") 'Merges Ref. Key 1 into Profit Center For x = 1 To iEndcol If InStr(.Cells(1, x), "Profit") > 0 Then Exit For Next For j = 1 To iEndcol If InStr(.Cells(1, j), "Ref") > 0 And InStr(Cells(1, j), "1") > 0 Then Exit For Next For y = 1 To lEndRowA If IsEmpty(.Cells(y, x)) Then .Cells(y, j).Copy Destination:=.Cells(y, x) End If Next 'And we move it... For x = 1 To iEndcol 'TOP SECTION OF DATA -FBL5N If InStr(.Cells(1, x), "Sold") Then v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) wDATA.Range(wDATA.Cells(2, 1), wDATA.Cells(lEndRowA, 1)) = v ElseIf .Cells(1, x) = "Invoice#" Then v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) wDATA.Range(wDATA.Cells(2, 2), wDATA.Cells(lEndRowA, 2)) = v ElseIf .Cells(1, x) = "Billing Doc" Then v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) wDATA.Range(wDATA.Cells(2, 3), wDATA.Cells(lEndRowA, 3)) = v ElseIf InStr(.Cells(1, x), "Cust Deduction") Then v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) wDATA.Range(wDATA.Cells(2, 4), wDATA.Cells(lEndRowA, 4)) = v ElseIf .Cells(1, x) = "A/R Adjustment" Then v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) wDATA.Range(wDATA.Cells(2, 5), wDATA.Cells(lEndRowA, 5)) = v ElseIf InStr(.Cells(1, x), "Possible Repay") Then v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) wDATA.Range(wDATA.Cells(2, 6), wDATA.Cells(lEndRowA, 6)) = v ElseIf InStr(.Cells(1, x), "Profit") Then v = .Range(.Cells(2, x), .Cells(lEndRowA, x)) wDATA.Range(wDATA.Cells(2, 7), wDATA.Cells(lEndRowA, 7)) = v End If Next End With End If ' DO NOT REDEFINE lEndrowA until all data is moved ' Fills in data from the second source, wLID If Not wLID Is Nothing Then 'wLID.Activate With wLID lEndRowB = .Cells(.Rows.Count, 1).End(xlUp).Row iEndcol = .Cells(1, 1).End(xlToRight).Column For x = 1 To iEndcol 'BOTTOM If InStr(.Cells(1, x), "Sold-To") Then v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) wDATA.Range(wDATA.Cells(lEndRowA + 1, 1), wDATA.Cells(lEndRowA + lEndRowB - 1, 1)) = v ElseIf .Cells(1, x) = "Invoice#" Then v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) wDATA.Range(wDATA.Cells(lEndRowA + 1, 2), wDATA.Cells(lEndRowA + lEndRowB - 1, 2)) = v ElseIf .Cells(1, x) = "Billing Doc" Then v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) wDATA.Range(wDATA.Cells(lEndRowA + 1, 3), wDATA.Cells(lEndRowA + lEndRowB - 1, 3)) = v ElseIf InStr(.Cells(1, x), "Cust Deduction") Then v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) wDATA.Range(wDATA.Cells(lEndRowA + 1, 4), wDATA.Cells(lEndRowA + lEndRowB - 1, 4)) = v ElseIf .Cells(1, x) = "A/R Adjustment" Then v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) wDATA.Range(wDATA.Cells(lEndRowA + 1, 5), wDATA.Cells(lEndRowA + lEndRowB - 1, 5)) = v ElseIf InStr(.Cells(1, x), "Possible Repay") Then v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) wDATA.Range(wDATA.Cells(lEndRowA + 1, 6), wDATA.Cells(lEndRowA + lEndRowB - 1, 6)) = v ElseIf InStr(.Cells(1, x), "Profit") Then v = .Range(.Cells(2, x), .Cells(lEndRowB, x)) wDATA.Range(wDATA.Cells(lEndRowA + 1, 7), wDATA.Cells(lEndRowA + lEndRowB - 1, 7)) = v End If Next End With End If 99 'wARadj.Select ' Range("A1:K1").Select MsgBox "All Done", vbOKOnly, "Yup." 100 'wBDwrk.Visible = False 'wPCwrk.Visible = False 'wDATA.Visible = False Application.CutCopyMode = False Application.ScreenUpdating = True End 101 '101 and greater are error handlings for specific errors MsgBox "Sorry, there was an error and you might not be able to use this macro. If there are formula errors, delete the formulas and try the macro again. If this wasn't the problem, send a copy of this file and a breif message about what you were doing to me at:" _ & vbNewLine & vbNewLine & "__________" & vbNewLine & vbNewLine & " I will try and let you know what happened ASAP.", , "I've gone Wonky." GoTo 100 102 MsgBox "This Macro can only run on a formatted Deduction Report or an FBL5N." _ & vbNewLine & vbNewLine & "If you are using either one, please exactly name the tabs 'Line Item Detail' for a Dedution Report or 'FBL5N' for an FBL5N" _ , vbOKOnly, "Line Item Detail or FBL5N Missing" GoTo 100 End Sub </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload