Johnny Thunder
Well-known Member
- Joined
- Apr 9, 2010
- Messages
- 693
- Office Version
- 2016
- Platform
- MacOS
Hello All, I am running into a really weird issue with a file that I am working on.
I have a master sheet that I take specific columns from and populate another sheet within the same workbook with and I am getting a block of my code skipped every other time I run the code?
Is that normal? The specific block is set to Filter Column (N) for "0.00" and delete all visible rows, this section of code sometimes run and other times it doesn't. I originally had an error handler but I have since commented it out so that I could see if there was an error causing the code to skip that section but the file currently runs without any errors.
Just thought I would mention that there is always "0.00" in column N so it should always be deleting something but sometimes the macro completes and there is still data with "0.00" in my column.
If anyone spots something I am doing incorrectly I would appreciate it. Thanks
Here is the full code:
I have a master sheet that I take specific columns from and populate another sheet within the same workbook with and I am getting a block of my code skipped every other time I run the code?
Is that normal? The specific block is set to Filter Column (N) for "0.00" and delete all visible rows, this section of code sometimes run and other times it doesn't. I originally had an error handler but I have since commented it out so that I could see if there was an error causing the code to skip that section but the file currently runs without any errors.
Just thought I would mention that there is always "0.00" in column N so it should always be deleting something but sometimes the macro completes and there is still data with "0.00" in my column.
If anyone spots something I am doing incorrectly I would appreciate it. Thanks
Here is the full code:
VBA Code:
Option Explicit
'--------------------------------------------------------------------------------------------
'--- Creates JE and appends details like G/L and Offsetting Line Items
'--------------------------------------------------------------------------------------------
Sub BuildJE()
Dim Sht As Worksheet, cSht As Worksheet, MainSht As Worksheet
Dim LastR As Long, LastR2 As Long
Dim Cell As Range, Cell2 As Range, rNG As Range
Dim BlockVariable As Variant, ShtName As Variant, ColumnL As Variant, ColAddress As Variant
Dim ColRange As String, AccountD As String, AccountC As String, ProjectType As String, CostCenterR As String, BusinessArea As String, CompCode As String
Dim Currency1 As String, HeaderText As String, Market As String, Territory As String
BlockVariable = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address '<----------------Gets the cell address that the VB Button is in and pressed - Will not work if manually triggered
Set MainSht = Sheets("Create JE")
ColAddress = MainSht.Range(BlockVariable).Column
Set cSht = Sheets("Financials and JE Calcs") 'Start Sheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Variables
With MainSht
ShtName = .Cells(19, ColAddress).Value 'Sht Name
ColumnL = .Cells(31, ColAddress).Value 'Column Location on JE Calcs Sheet
BusinessArea = .Cells(26, ColAddress).Value 'Business Area
CompCode = .Cells(25, ColAddress).Value 'Company Code
Currency1 = .Cells(29, ColAddress).Value
HeaderText = .Cells(30, ColAddress).Value
Market = .Cells(27, ColAddress).Value
Territory = .Cells(28, ColAddress).Value
End With
Set Sht = Sheets(ShtName) 'Destination
ColRange = ColumnL & ":" & ColumnL 'Defines the column that the JE Type is in
LastR2 = cSht.Evaluate("match(2,1/(" & ColRange & "<>0))") 'Gets that last row in the column needed and defines the last row with a formula result
If MainSht.Range(BlockVariable).Offset(47, 0).Value = 0 Then 'Original JE Total
MsgBox Prompt:="There's no data to create a JE.", Title:="OOPS!"
Else
'On Error Resume Next
With Sht
.Range("B4:B" & LastR2 - 5).Value = "40" 'Posting key
.Range("E4:E" & LastR2).NumberFormat = "@" 'Formats Business Area before Paste
.Range("E4:E" & LastR2 - 5 & "").Value = BusinessArea 'Business Area
.Range("C2").Value = Range("PostingDate") 'Posting Date
.Range("D2").Value = CompCode 'Company Code
.Range("F2").Value = Range("PostingPeriod") 'Posting Period
.Range("G2").Value = Range("PostingFY") 'Fiscal Year
.Range("E2").Value = "YA" 'Doc Type
.Range("H2").Value = Currency1 'Currency
.Range("I2").Value = HeaderText 'Header Text
.Range("Z4:Z" & LastR2 - 5).Value = Market 'Market
.Range("AA4:AA" & LastR2 - 5).Value = Territory 'Territory
'ACN - Full Level with Episode
cSht.Range("B9:B" & LastR2).Copy
.Range("Y4").PasteSpecial xlValues
'Amount
cSht.Range(ColumnL & "9:" & ColumnL & LastR2).Copy 'Defines the column to pick up Amounts
.Range("N4").PasteSpecial xlValues
'Project Type - Internal, External, Work for Hire - GL Acccount for Debit Side
cSht.Range("M9:M" & LastR2).Copy 'Will bring in the Project Type for Calculation and then Clear After
.Range("J4").PasteSpecial xlValues
'Project Type - GL Acccount for Debit Side
cSht.Range("AS9:AS" & LastR2).Copy 'Brings in Project GL Code - Debit
.Range("M4").PasteSpecial xlValues
Application.CutCopyMode = False
End With
'------------------------------Clean Up Blank Rows-------------------------------
LastR = Sht.Cells(Rows.Count, "N").End(xlUp).Row '2 refers to the row to start on
'Enters Sheet Type
Sht.Range("K4:K" & LastR).Value = ShtName
'Application.Goto Sht.Range("A1")
'xxxxxxxxxxxxxxxxxxxxxxx Here is the section of code that is having trouble xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'1. Apply Filter
Sht.Range("A3:AA" & LastR).AutoFilter Field:=14, Criteria1:="0.00"
'2. Delete Rows
Application.DisplayAlerts = False
Sht.Range("A4:AA" & LastR).SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
Sht.ShowAllData
'xxxxxxxxxxxxxxxxxxxxxxx Here is the section of code that is having trouble xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'------------------------------Clean Up Blank Rows-------------------------------
LastR = Sht.Cells(Rows.Count, "B").End(xlUp).Row '2 refers to the row to start on
For Each Cell In Sht.Range("B4:B" & LastR & "")
If Cell.Value = "40" Then
ProjectType = Cell.Offset(0, 8).Value
Cell.Offset(1, 0).EntireRow.Insert shift:=xlDown
Range(Cell.Offset(1, 2), Cell.Offset(1, 25)).Value = Range(Cell.Offset(0, 2), Cell.Offset(0, 25)).Value
Cell.Offset(1, 0).Value = "50" 'Offset Line
'------------------------------Case Statement-------------------------------
Select Case ProjectType
Case "External"
CostCenterR = MainSht.Range(BlockVariable).Offset(36, 0).Value 'Cost Center
Case "Internal"
CostCenterR = MainSht.Range(BlockVariable).Offset(37, 0).Value 'Cost Center
Case "Work for Hire"
CostCenterR = MainSht.Range(BlockVariable).Offset(38, 0).Value 'Cost Center
End Select
'------------------------------Case Statement-------------------------------
Cell.Offset(0, 1).Value = Cell.Offset(0, 11).Value 'Credit Account
Cell.Offset(1, 1).Formula = "=IFERROR(VLOOKUP(M" & Cell.Row & ",'Lookup Tables'!$AB$3:$AC$14,2,0),"""")" 'Credit Account
Cell.Offset(1, 2).Value = CostCenterR 'Cost Center - Debit
Cell.Offset(0, 2).Value = CostCenterR 'Cost Center - Credit
End If
Next Cell
LastR = Sht.Cells(Rows.Count, "B").End(xlUp).Row '2 refers to the row to start on
Sht.Range("O4:O" & LastR & "").Formula = "=VLOOKUP(Y4,'User Inputs'!B:F,5,0) & "" - "" & MID(CELL(""filename"",A1),FIND(""]"",CELL(""filename"",A1))+1,255)" 'Formula Description"
Sht.Range("A4:A" & LastR & "").Formula = "=ROW()-3" 'Apply Row Number
Sht.Range("N4:N" & LastR & "").NumberFormat = "0.00" 'Format Amount Column
Sht.Range("A4:AA" & LastR).Value = Sht.Range("A4:AA" & LastR).Value 'Hardcodes the description
Sht.Range("J4:M" & LastR & "").ClearContents
'Call CreateJVTemp '<--------------Macro Call
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox Prompt:="Entries have been created", Title:="Finito!"
End If
End Sub
