Preamble: I'm a self taught hand at anything VB script. Most of my stuff is hodgepodged-together scripts I've found.
I need to sort rows into different sheets based on a set of cell values.
In some instances its a set of numbers which would apply, in others it's a very direct value.
See:
A cell value of 1-99 goes to a sheet titled "1-99"
A cell value of 100 goes to a sheet titled "100"
There are several ranges like that. The working iteration I have only works for the direct value.
Basically, how to I get the script to understand less than or greater than or both--for instances in which it's between sets (see: 101-199)?
Set Sorter = Sheets("Raw Data").Range("M2:M100000")
For Each cell In Sorter
If cell.Value = "100" Then
cell.EntireRow.Copy
Sheets("100").Range("C" & Rows.Count).End(xlUp).Offset(1, -2).PasteSpecial
If cell.Value = "200" Then
cell.EntireRow.Copy
Sheets("200").Range("C" & Rows.Count).End(xlUp).Offset(1, -2).PasteSpecial
End If
Next
Application.CutCopyMode = False
Thank you for any and all help.
EDIT:
Below are the ranges:
1-99
100
101-199
200
201-299
300
I've got a solution for you that should show you some good concepts in VBA.
PREP FROM YOU:
Create sheets named "1-99", "100", "101-199", "200", "201-299", "300"
Include the header rows, the code I wrote works from row 2, so if your headers take up more than that, you will simply have to modify the initialization part.
Copy this code into a module and run it.
PROCESS:
Initialize the row numbers and names of all the sheets
Loop through "Raw Data" and get the tempValue to evaluate.
Using SELECT CASE statements, decide which rows go to which sheets.
Pass some arguments into a sub that will move the data accordingly, saving space and sanity.
NOTE: I'm unsure of your column that has the value to check, It looked like "M" so that's what I'm using. If it's "A" you can change it, and let me know, I will modify the answer.
TESTED:
Sub SortValuesToSheets()
Dim lastRow As Long
Dim lastCol As Long
Dim tempValue As Double 'Using Double not knowing what kind of numbers you are evaluating
Dim lRow As Long
Dim sh1 As String, sh2 As String, sh3 As String
Dim sh4 As String, sh5 As String, sh6 As String
Dim raw As String
Dim sh1Row As Long, sh2Row As Long, sh3Row As Long
Dim sh4Row As Long, sh5Row As Long, sh6Row As Long
'INITIALIZE TARGET SHEETS
'Name the target sheets
raw = "Raw Data"
sh1 = "1-99"
sh2 = "100"
sh3 = "101-199"
sh4 = "200"
sh5 = "201-299"
sh6 = "300"
'Set the row number for each target sheet to 2, to account for headers
sh1Row = 2
sh2Row = 2
sh3Row = 2
sh4Row = 2
sh5Row = 2
sh6Row = 2
lastRow = Sheets(raw).Cells(Rows.Count, "A").End(xlUp).row 'Get the last Row
lastCol = Sheets(raw).Cells(2, Columns.Count).End(xlToLeft).Column 'and column
'BEGIN LOOP THROUGH RAW DATA
For lRow = 2 To lastRow
tempValue = CDbl(Sheets(raw).Cells(lRow, "M").Value) 'set TempValue to SEARCH COLUMN
Select Case tempValue
Case Is < 1
MsgBox ("Out of Range, Under 1")
Case 1 To 99
Call CopyTempRow(lRow, sh1, sh1Row, lastCol)
sh1Row = sh1Row + 1
Case 100
Call CopyTempRow(lRow, sh2, sh2Row, lastCol)
sh2Row = sh2Row + 1
Case 101 - 199
Call CopyTempRow(lRow, sh3, sh3Row, lastCol)
sh3Row = sh3Row + 1
Case 200
Call CopyTempRow(lRow, sh4, sh4Row, lastCol)
sh4Row = sh4Row + 1
Case 201 - 299
Call CopyTempRow(lRow, sh5, sh5Row, lastCol)
sh5Row = sh5Row + 1
Case 300
Call CopyTempRow(lRow, sh6, sh6Row, lastCol)
sh6Row = sh6Row + 1
Case Is > 300
MsgBox ("Out of Range, Over 300")
End Select
Next lRow
End Sub
This is the subroutine that will copy the entire row. The reason for separating it is so that we don't have to re-write for each case with the slight variations. You wouldn't want to see this loop 6 times with only one number being changed each time. If you have to change it, you change it here, once, and call it whenever you need.
Sub CopyTempRow(row As Long, target As String, tRow As Long, lastCol As Long)
For lCol = 1 To lastCol
Sheets(target).Cells(tRow, lCol) = Sheets("Raw Data").Cells(row, lCol)
Next lCol
End Sub
Untested:
Dim v, s
Set Sorter = Sheets("Raw Data").Range("M2:M100000")
For Each cell In Sorter
v = cell.Value
if Len(v) > 0 And Isnumeric(v) Then
If v>1 and v<=99 Then
s = "1-99"
Elseif v = 100 Then
s = "100"
Else
s = ""
End If
If s<>"" Then
Sheets(s).Range("C" & Rows.Count).End(xlUp).Offset(1,0).Entirerow.Value = _
c.entirerow.Value
End if
End if
Next
Related
I am trying to write a VBA code where I want to populate DATA from a worksheet Range A to AQ spanning over multiple Rows. AQ contains Value "Open" or "Closed". I want to get the rows where AQ value is closed. I tried using the AutoFilter. This is working fine to an extent. But I have to use 2 For loops. One for Each Row and another for Each Column to populate Row wise, column by column into the list box
My Code as follows:
Note : Actual contents start from 6th Row where 6 contains the headers and data starts from 7th Row
Dim i As Long
Dim rowRange As Range
Dim AllData(1 To 1000, 1 To 43) As String
lstRecords.ColumnCount = 43
Set shDSR = mydata1.Sheets("DSR")
last_Row = shDSR.Cells(Rows.Count, 1).End(xlUp).Row
shDSR.AutoFilterMode = False
shDSR.Range("A6:AQ" & last_Row).AutoFilter Field:=43, Criteria1:="CLOSED"
Set rng = shDSR.Range("A6:AQ" & last_Row).SpecialCells(xlCellTypeVisible)
Dim filtrRow() As String
Dim rowCnt As Long
'Me.lstRecords.Clear
rowCnt = 0
If rng.Count > 0 Then
Me.lstRecords.Clear
Me.lstRecords.ColumnCount = rng.Columns.Count
For Each Row In rng.Rows
Me.lstRecords.AddItem
rowCnt = rowCnt +1
filterRow = Range(Row.Address)
'Me.lstRecords.List() = filterRow ''This throws error Type Mismatch so not using
For i = 1 To Row.Columns.Count
AllData(rowCnt, i) = Row.Cells(1, i).Value ''Move to Array
Me.lstRecords.List(rowCnt - 1, i - 1) = filterRow(1, i)'Buggy error when i = 11
Next
Next
'' Following segment works. Add data to Array and then populate ListBox from Array
Me.lstRecords.List() = AllData
Else
MsgBox "No data matches the filter criteria."
End If
Above Code has both approaches
a) Trying to load directly from excel Range (actually using filterRow, but can also directly use range with same issue). But, this approach stops always when i=11 with Invalid property error. I tried changing the data contents etc still same issue
Another Issue when Not taking the array based approach, only one line is added, so in affect only last line is available in the list box
b) Using the AllData array. I load all the row data (matching criteria) into the array and finally populate the listbox from array. THIS WORKS. But I do not like this approach
Can some one please point out where it is going wrong.
Thanks in advance
Problem is that filters create a non contiguous range consisting of areas which you have to iterate separately.
Option Explicit
Sub demo()
Dim mydata1 As Workbook, shDSR As Worksheet
Dim rng As Range, a As Range, r As Range
Dim last_row As Long, n As Long
Dim i As Long, rowCnt As Long
Dim ListData() As String
' change this
Set mydata1 = ThisWorkbook
Set shDSR = mydata1.Sheets("DSR")
With shDSR
.AutoFilterMode = False
last_row = .Cells(.Rows.Count, "AQ").End(xlUp).Row
.Range("A6:AQ" & last_row).AutoFilter Field:=43, Criteria1:="CLOSED"
Set rng = .Range("A6:AQ" & last_row).SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
End With
' clear listbox
With Me.lstRecords
.Clear
.ColumnCount = rng.Columns.Count
End With
'iterate areas and rows to count visible rows
For Each a In rng.Areas
n = n + a.Rows.Count
Next
rowCnt = 0
If n > 1 Then
' size array
ReDim ListData(1 To n, 1 To rng.Columns.Count)
' fill array
For Each a In rng.Areas
For Each r In a.Rows
rowCnt = rowCnt + 1
For i = 1 To UBound(ListData, 2)
ListData(rowCnt, i) = r.Cells(1, i).Value ''Move to Array
Next
Next
Next
' populate ListBox from Array
Me.lstRecords.List() = ListData
Else
MsgBox "No data matches the filter criteria."
End If
End Sub
I am quite new to VBA so my question may sound silly to some of you.
I have a problem with my code. I am trying to check between 2 sheets(1st: test and 2nd: test data. In the code I am using the code name of the sheets) how may times a criteria/my product is met and based on that number to add that many rows beneath the SKU/product.
What I want to do is, if for my first product/SKU I have stock in 5 different locations, I want to add 5 rows in the first sheet and to see the qty in column D and the location in column E.
TestData tab
The reason why I need to list the quantity in different cells is that the stock is in different locations, so I can not just add in to one cell.
I am also adding screen shots of how my two sheets look like.
I have not add the loop to find the location yet, but I want to understand how to add the rows first.
Sub test()
Dim myrange As Range, testrange As Range, cell As Range, result As Range
Dim i As Long, testlastrow As Long, lastrow As Long
Dim helprng As Range
lastrow = TESTTAB.Range("a" & Rows.Count).End(xlUp).row
testlastrow = TDATA.Range("a" & Rows.Count).End(xlUp).row
Set testrange = TDATA.Range("a2:c" & testlastrow)
Set myrange = TESTTAB.Range("b2:b" & lastrow)
Set result = TESTTAB.Range("d2:e" & testlastrow)
Set helprng = TESTTAB.Range("f2:f" & lastrow)
For Each cell In myrange
For i = 1 To lastrow
If cell.Cells(i, 1) = testrange.Cells(i, 1) Then
result.Cells(i, 1) = testrange.Cells(i, 2)
End If
Next i
Next cell
End Sub
Here is the raw structure you were asking for.
Sub test()
' 011
Dim Rng As Range
Dim Tmp As Variant
Dim Radd As Long ' number of rows to add
Dim R As Long ' row counter
With Tdata
' Range, Cells and Rows Count, all in the same sheet
' exclude caption row(s)
Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
Application.ScreenUpdating = False ' speed up the process
With TestTab
' end the loop in row 2 because row 1 might contain captions
' loop bottom to top because row numbers will change
' below the current row as you insert rwos
' column 1 = "A"
For R = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
Tmp = .Cells(R, 1).Value
Radd = Application.CountIf(Rng, Tmp)
If Radd > 1 Then
.Range(.Rows(R + 1), .Rows(R + Radd)).Insert
.Cells(R + 1, 1).Value = Radd ' for testing purposes
End If
Next R
End With
Application.ScreenUpdating = True ' now you look
End Sub
As our Evil Blue Monkey has suggested, inserting blank rows and then populating them may not be the most efficient way. You can copy a row and then click Insert to insert the copied data into a new row. Get the syntax from the Macro recorder if it's of interest. It works with the Range object the same way.
im hoping that someone can help me to take a macro down an entire column.here is what i am trying to do.
the following table is in a worksheet called barcode. it is my master list. column E:E, is a helper column that has part numbers with countif numbers attach like so=:1,:2,:3, etc. i did this because i have multiple orders for part numbers that are due on different dates in the order report. in column c, there is a number of how many of a part has been ran. in column d, the number of parts that have been scrapped and would have to be ran again. i have highlighted a row to use as an example. in this case. part number ms-100 has a total of 1 part ran and zero scrapped.
the next sheet is my order report sheet. it displays what a customer has ordered of what part. the calculation that i want to have is: if ms-100:1 on the order report matches what is on the master list, then take the qty from the order report and subtract how many were ran, and add how many were scrapped. so for this case. if ms-100:1 =ms-100:1 then cell f8 =12-1+0.
my current code will do that, but it will only do the cells that i point them to and not the entire column. to make it easier to see if this code works or not, instead of changing the values of column f on the order report, i moved it to column l. the goal is to have the value change in f, but for now i was putting the value in l. as you can see, in L7, it says no order. i hope this clarifies what i am trying to accomplish. thank you very much. here is the code that i have so far. i was attempting to use for each cell but it doesnt seem to be working.
Sub FIND_MATCHES()
Dim sh1 As Worksheet
Dim sh4 As Worksheet
Set sh1 = ActiveWorkbook.Sheets("BARCODE")
Set sh4 = ActiveWorkbook.Sheets("ORDER REPORT")
Dim CELL As Range
Dim LASTROW As Long
Dim R As Long
Dim c As Range
Set c = sh4.Range("L:L")
LASTROW = sh4.CELLS(Rows.COUNT, 12).End(xlDown).Row
'LASTROW = Range("F7:F" & Rows.COUNT).End(xlUp).Row
Dim COMPID As Range
Set COMPID = sh1.Range("E:E").Find(What:=sh4.Range("N7").Value, LookIn:=xlValues, LOOKAT:=xlWhole)
'sh4.Range("L7:L" & LASTROW).Activate
'sh4.Range("L7:L" & LASTROW).Select
For Each CELL In c
If COMPID Is Nothing Then
sh4.Range("L7").Value = "NO ORDER"
Else
'TEST CELL'sh4.Range("L7").Value = COMPID.Offset(, -2).Value
sh4.Range("L7").Value = sh4.Range("F7").Value - COMPID.Offset(0, -2).Value + COMPID.Offset(0, -1).Value
'Range("L7:L" & LASTROW).Select
' Range("L8").Select
Exit For
End If
Next CELL
End Sub
I was able to find the solution myself. the below code is what i used. I thought i would share it just in case someone else had the same issue.
Sub FIND_MATCHES()
Dim barcode As Worksheet
Dim order As Worksheet
Set barcode = ActiveWorkbook.Sheets("BARCODE")
Set order = ActiveWorkbook.Sheets("ORDER REPORT")
Dim LASTROW As Long
Dim c As Long
Dim X As Integer
X = 1
Dim finalrow As String
finalrow = order.cells(Rows.COUNT, 12).End(xlUp).Row
Dim location As Range
Set location = barcode.cells.Item(X, "E")
Dim HELPER As String
Dim NUMROWS As String
NUMROWS = order.cells(Rows.COUNT, 14).End(xlUp).Row
HELPER = barcode.cells.Item(X, "E").Value
LASTROW = order.cells(Rows.COUNT, 14).End(xlUp).Row
Dim ENDROW As String
ENDROW = order.cells(Rows.COUNT, 4).End(xlUp).Row
For X = 1 To ENDROW
For c = 7 To NUMROWS
If order.cells(c, 14).Value = barcode.cells.Item(X, "E").Value Then
order.cells(c, 12).Value = order.cells(c, 6).Value - barcode.cells.Item(X, "E").OFFSET(0, -2).Value + barcode.cells.Item(X, "E").OFFSET(0, -1).Value
Else
ActiveCell.OFFSET(1, 0).Select
End If
Next c
Next X
order.Range("A2").Select
End Sub
I've tried to figure out the last used column in my excel spreadsheet using VBA to start writing something right after that column. In the image below I've tried to show what I meant and where I wanna start writing from. The desired field is already selected there which is "F2".
However, the problem is the data already available there did not maintain uniformity. How can I figure out the last used column using VBA?
This is my try:
Sub FindLastColumn()
Dim lCol&
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox lCol
End Sub
It produces 8 as result which is not correct as the right one should be 5.
The data-ridden sheet looks like below:
If you want to find the last column in your range excluding the header, you could achieve that as below, amend the Sheet name from Sheet1 to the Sheet you are actually using:
Sub foo()
LastRow = Sheet1.UsedRange.Rows.Count
'get the last row with data in your used range
MaxCol = 1
For i = 2 To LastRow 'loop from row 2 to last
If Sheet1.Cells(i, Sheet1.Columns.Count).End(xlToLeft).Column > MaxCol Then
MaxCol = Sheet1.Cells(i, Sheet1.Columns.Count).End(xlToLeft).Column
'get the highest value for the column into variable
End If
Next i
MsgBox MaxCol
End Sub
It appears that you want to find the right-hand most used column in rows 2 to the end of your data. To do that, you'll need to loop through all the rows of data keeping track of which column is Max(LastUsedColumn). Unfortunately, there is no such built in function, but you could write one something like this:
Public Function MaxUsedColumnInRow(ByVal SheetToCheck As Worksheet, ByVal RowToCheck As Long) As Long
MaxUsedColumnInRow = SheetToCheck.Cells(RowToCheck, Columns.count).End(xlToLeft).Column
End Function
Now that you have a nifty function to determine which is the maximum used column in a row, you can call it in a loop, like this:
Public Function MaxUsedColumnInRange(ByVal SheetToCheck As Worksheet, ByVal StartRow As Long, ByVal EndRow As Long) As Long
Dim curRow As Long
For curRow = StartRow To EndRow
Dim CurCol As Long
CurCol = MaxUsedColumnInRow(SheetToCheck, curRow)
Dim maxCol As Long
If CurCol > maxCol Then
maxCol = CurCol
End If
Next
End Function
And, finally, give it a quick test replacing "Sheet1" with the name of the worksheet you're specifically checking:
Public Sub TestIt()
MsgBox "Max Used column on sheet1 = " & CStr(MaxUsedColumnInRange("Sheet1", 2, 50))
End Sub
Of course, you'll want to determine the max used row on your sheet and pass that into the the MaxUsedColumnInRange function - unless you happen to have exactly 50 rows of data, the example test Sub probably won't get you your actual desired result.
As a side benefit, you now have a handy function you can call in the future to determine the max column in a row so you don't have to remember the proper way of doing it. (I usually forget so I have to look it up, or use a nifty helper function to "remember" for me.)
Use a variation of the Find method of finding it, but limit it to ignore row 1:
Sub Test()
Dim rng As Range
Set rng = LastCell(Sheet1)
MsgBox "Last cell containing data is " & rng.Address & vbCr & _
"Selected cell is in example is " & Sheet1.Cells(2, rng.Column + 1).Address
End Sub
Public Function LastCell(wrkSht As Worksheet) As Range
Dim lLastCol As Long, lLastRow As Long
On Error Resume Next
With wrkSht.Rows("2:1048576")
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
If lLastCol = 0 Then lLastCol = 1
If lLastRow = 0 Then lLastRow = 1
Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
End With
On Error GoTo 0
End Function
Easy route would be to use Find like below:
Dim rgLastColumnCell As Range
Set rgLastColumnCell = ActiveSheet.Cells.Find("*", , , , xlByColumns, xlPrevious)
MsgBox "Last Used Column is : " & rgLastColumnCell.Column
Adjust ActiveSheet.Cells portion to suit your need like: Activesheet.Range("B2:XFD1048576") if you want to skip first row from the check.
You cannot get the result you require by using built-in functions, either you can get the column H because it is the last used column or the column B, because it is the last filled column, To get E you have to write your own code, and by the look of it, it seems that you want the end of the colored range. You can check the last column where color is not present in a loop
Sub checkLastColumn()
col_num = 1
Do While Cells(2, col_num).Interior.Pattern <> xlNone
col_num = col_num + 1
Loop
MsgBox col_num
End Sub
It will return column F
EDIT....
As I said earlier you cannot get the cell you require by any built-in function, you have to write some code, and in order to do that you must have a definite logic that should be known and decided between you and the users of the sheet.
For example:
you can color the range as you have already done
You can name the column header, as in your example, it is status.
You can fix the number of data columns and status columns, and there will be no need to use any code
For finding the status column or any other if you decide you can use a loop as below
Sub getStatusColumn()
col_num = 1
Do While Cells(1, col_num) <> "status"
col_num = col_num + 1
Loop
MsgBox col_num
End Sub
OR
Sub getLastItemColumn()
col_num = 1
Do While Left(Cells(1, col_num), 4) = "Item"
col_num = col_num + 1
Loop
MsgBox col_num
End Sub
UPDATE:
Alright, so i used the following code and it does what i need it to do, i.e check if the value is 0 and if its is, then delete the entire row. However i want to do this to multiple worksheets inside one workbook, one at a time. What the following code is doing is that it removes the zeros only from the current spreadsheet which is active by default when you open excel through the VBA script. here the working zero removal code:
Dim wsDCCTabA As Excel.Worksheet
Dim wsTempGtoS As Excel.Worksheet
Set wsDCCTabA = wbDCC.Worksheets("Login")
Set wsTempGtoS = wbCalc.Worksheets("All_TemporaryDifferences")
Dim LastRow As Long, n As Long
LastRow = wsTempGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If Cells(n, 5).Value = 0 Then
Cells(n, 5).EntireRow.Delete
End If
Next
What am i doing wrong? when i do the same thing for another worksheet inside the same workbook it doesnt do anything. I am using the following code to remove zeros from anohter worksheet:
Set wsPermGtoS = wbCalc.Worksheets("All_PermanentDifferences")
'delete rows with 0 description
Dim LastRow As Long, n As Long
LastRow = wsPermGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If Cells(n, 5).Value = 0 Then
Cells(n, 5).EntireRow.Delete
End If
Next
Any thoughts? or another way of doing the same thing?
ORIGINAL QUESTION:
I want to delete all the rows which have a zero in a particular column. I am using the following code but nothing seems to happen:
CurrRow = (Range("E65536").End(xlUp).Row)
For Count = StartRow To CurrRow
If wsDCCTabA.Range("E" & Count).Value = "0" Then
wsDCCTabA.Rows(Count).Delete
End If
Next
StartRow contains the starting row value
CurrRow contains the row value of the last used row
See if this helps:
Sub DelSomeRows()
Dim colNo As Long: colNo = 5 ' hardcoded to look in col 5
Dim ws As Worksheet: Set ws = ActiveSheet ' on the active sheet
Dim rgCol As Range
Set rgCol = ws.Columns(colNo) ' full col range (huge)
Set rgCol = Application.Intersect(ws.UsedRange, rgCol) ' shrink to nec size
Dim rgZeroCells As Range ' range to hold all the "0" cells (union of disjoint cells)
Dim rgCell As Range ' single cell to iterate
For Each rgCell In rgCol.Cells
If Not IsError(rgCell) Then
If rgCell.Value = "0" Then
If rgZeroCells Is Nothing Then
Set rgZeroCells = rgCell ' found 1st one, assign
Else
Set rgZeroCells = Union(rgZeroCells, rgCell) ' found another, append
End If
End If
End If
Next rgCell
If Not rgZeroCells Is Nothing Then
rgZeroCells.EntireRow.Delete ' deletes all the target rows at once
End If
End Sub
Once you delete a row, u need to minus the "Count" variable
CurrRow = (Range("E65536").End(xlUp).Row)
For Count = StartRow To CurrRow
If wsDCCTabA.Range("E" & Count).Value = "0" Then
wsDCCTabA.Rows(Count).Delete
' Add this line:
Count = Count - 1
End If
Next
I got it. For future reference, i used
ActiveWorkbook.Sheets("All_temporaryDifferences").Activate
and
ActiveWorkbook.Sheets("All_Permanentdifferences").Activate
You don't need to use ActiveWorkbook.Sheets("All_temporaryDifferences").Activate. In fact if the ActiveWorkbook is different from wbCalc you would get an error.
Your real problem is that you are using an unqualified reference to Cells(n, 5).Value. Unqualified means that you aren't specifying which sheet to use so it defaults to the active sheet. That may work sometimes but it is poor code. In your case it didn't work.
Instead you should always use qualified references. wsTempGtoS.Cells(n, 5).Value is a qualified reference. wsTempGtoS specifies which worksheet you want so VBA is not left guessing.
Dim LastRow As Long, n As Long
LastRow = wsTempGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If wsTempGtoS.Cells(n, 5).Value = 0 Then
wsTempGtoS.Cells(n, 5).EntireRow.Delete
End If
Next
This: CurrRow = (Range("E65536").End(xlUp).Row) is also an unqualified reference. Instead it should be CurrRow = wsDCCTabA.Range("E65536").End(xlUp).Row.