Excel VBA script filters header unexpectedly - vba

Introduction
I have some spreadsheets like the following.
Here the header is on rows 16 and 17. There is a "header" to the left (not shown) among the earlier rows and columns that includes a picture, some non-tabular data, a legend, etc., that is unimportant here. Header text on row 16 is obfuscated because reasons. Data marked in bold red indicates that that sample point has undergone some process. Here is the code snippet from the script that highlights those data points in bold red.
' Traverse columns applying redding until hitting the row end, Comment, or SpGr: whichever comes first
For currIndex = abcDateCol + 1 To lastCol
' Check for exit conditions:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For
If Cells(abcDateRowDesc, currIndex).Value() <> "" Then
If Cells(abcDateRowDesc, currIndex + 1).Value() = "process" Then
' Looks like we have a column of something Red-able
Columns(ColumnLetter(currIndex) & ":" & ColumnLetter(currIndex + 1)).Select
Selection.AutoFilter ' Turn on autofiltering (hopefully)
Selection.AutoFilter Field:=2, Criteria1:="=1", Operator:=xlOr, Criteria2:="=e"
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Selection.AutoFilter ' Turn off autofiltering
Columns(ColumnLetter(currIndex + 1) & ":" & ColumnLetter(currIndex + 1)).EntireColumn.Delete Shift:=xlToLeft
End If
End If
Next currIndex
Context
Here, abcDateCol refers to column AE, lastCol refers to column AQ, abcDateRow (not shown, but available) and abcDateRowDesc refer to the header rows 16 and 17 respectively, and the ColumnLetter function is a user-defined function that returns the human-readable column letter(s) given a column number; this is common functionality you may have seen elsewhere, or even made yourself.
Let's Continue
Never mind that the condition in If Cells(abcDateRowDesc, currIndex).Value() = "Comments" is never satisfied because of an oversight (I'm assuming) -- two different rows, guaranteed.
Let's take a look at what the spreadsheet looks like before this script is executed.
So, the script takes pairs of columns, and for each pair of columns it marks data cells bold red if a data cell's right-adjacent cell has a 1 (or an "e"?) (as a boolean; answers the question, "Has this sample point undergone whatever process?") and then trashes the "process" column.
The Problem
A client wants the gratuitous header gone, so they may more easily import the spreadsheet into whatever solution they have. Delete rows 1 through 15, and this is what I get.
What in the bleepity-bleep happened to the header? I don't understand how this first row gets highlighted. It seems too perfectly weird. Now, let's revisit the very first spreadsheet.
I've filled the "header" with some dummy text after the script executed. Wow, there's the first row reddened again, this time ad infinitum! So, this problem has always existed. Oh, and the first column, too! And, it magically stops right above the proper header so we would never see it.
The Questions
Why is this script unexpectedly reddening the first row and column? Can this be easily solved, or am I looking at some sort of a rewrite? If so, please point me in the general direction.
It helps to mention that these spreadsheets are generated from a Windows application and their scripts executed before a user has a copy of their spreadsheet. Also, regarding the second picture (the spreadsheet with the "process" columns shown), this spreadsheet is not something that normally exists. I generated it for the sake of this post by skipping the script's for loop. The application uses a chosen spreadsheet template, that looks the same minus the data, fills in the sample data, and then executes several scripts over the data.
I considered using conditional formatting, but there are a few dozen spreadsheet templates. Even if I just change the one I need, I can't change the fact that these common scripts run over it. I feel my best option is to correct the script. And, I wouldn't change the script to account for my edge case. The whole ecosystem feels flaky, but that's just subjective.
Note
I am not the author of this script (or any of my company's VBA!). I'm considering this an inheritance tax levied upon me.
*Update
I was asked if I traced through this code. I apologize that I didn't include that information in my original post. Here is what I know. Selection.Font.ColorIndex = 3 turns the cells in the selection that satisfy the autofilter plus the first row (two cells as only two columns are selected at a given time), and Selection.Font.Bold = True makes the same cells bold in the same manner. I suspect it has something to do with the autofilter, so I'm going to take a look at the answers now.

This edit should fix your problems, hopefully (they did for my remake of your spreadsheet, but we won't know til you try on the real thing)
' Traverse columns applying redding until hitting the row end, Comment, or SpGr: whichever comes first
For currIndex = abcDateCol + 1 To lastCol
' Check for exit conditions:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For
If Cells(abcDateRowDesc, currIndex).Value() <> "" Then
If Cells(abcDateRowDesc, currIndex + 1).Value() = "process" Then
' Looks like we have a column of something Red-able
'Columns(ColumnLetter(currIndex) & ":" & ColumnLetter(currIndex + 1)).Select
With Range(Cells(abcDateRowDesc, currIndex), Cells(abcDateRowDesc, currIndex + 1).End(xlDown))
.AutoFilter 2, "=1", xlOr, "=e"
' Don't format header
With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) .Font.ColorIndex = 3
.Font.Bold = True
.AutoFilter ' Turn off autofiltering
End With
End With
Columns(currIndex + 1).Delete xlShiftLeft
End If
End If
Next currIndex
This all starts with a quirk of how the code is choosing its range to autofilter. The selected area is the full column, instead of the area you actually want to format (row 18 to the last entry). It seems that autofiltering on a full column with empty top rows automatically sets the first nonempty row as the header row. So the header is left unfiltered/unhidden by the statement, and it gets colored in as part of the full column selection. So that's why your headers are getting colored.
Now, if you tried to test this by putting data in the above empty rows like "a", those values would become the first ones in the column and would be selected as the headers - meaning those values get colored. Whatever is in the first nonempty row of your columns will be the autofilter header and will get colored.
But that should only affect the columns you explicitly colored, not the entirety of the first row, right? The problem here is that Excel likes to make assumptions about data in order to save time. So if you have a whole row full of red, bold "a"'s and right next to them you put in another "a" to test whether that cell is formatted or not... well, it automatically gives you a red, bold "a" despite the cell being previously unformatted! And if you keep going down the row in this way, it'll appear like your whole row got formatted. But, if you were to jump over a few columns (say, 5-ish) and enter in another "a", voila, it's unformatted, and any "a"s you put in near it will be too. You can also check what Excel by deleting an unformatted "a" in a far off column, then continuing to enter "a"'s all the way down until you reach that same cell - this time, the "a" will be red and bold because all of the others in the row were, too, even though we just checked that this was an unformatted cell!
Basically, having the wrong range for your autofilter made things act very unexpectedly, then trying to test the formatting issue by entering in values just made everything less clear. The code I've provided just autofilters the relevant area (row 17 to the last contiguous row), fixing the core issue.

here's a (commented) refactoring of your code that should do:
Option Explicit
Sub main()
Dim abcDateCol As Long, lastCol As Long, abcDateRow As Long, abcDateRowDesc As Long, currIndex As Long
abcDateCol = 31
lastCol = 43
abcDateRow = 16 '<--| you can change it to 1 for the last "scenario"
abcDateRowDesc = 17 '<--| you can change it to 2 for the last "scenario"
For currIndex = abcDateCol + 1 To lastCol '<--| loop through columns
With Cells(abcDateRow, currIndex) '<--| refer to cell in current column on row abcDateRow
If .Value = "Comments" Then Exit For '<--| Check for exit conditions on row 'abcDateRow'
If .Offset(1).Value <> "" And .Offset(1, 1).Value = "process" Then '<--| Check for processing conditions on row 'abcDateRowDesc'
With .Resize(.Offset(, 1).End(xlDown).Row - .Row + 1, 2) '<-- consider the range from current referenced cell 1 column to the right and down to last 'process' number/letter
.AutoFilter Field:=2, Criteria1:="=1", Operator:=xlOr, Criteria2:="=e" '<--| filter on "process" field with "1" or "e"
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any values match...
With .Offset(2).Resize(.Rows.Count - 2, 1).SpecialCells(xlCellTypeVisible).Font '<--|... consider only filtered values skipping headers (2 rows), and apply formatting
.ColorIndex = 3
.Bold = True
End With
End If
.AutoFilter '<-- reset autofilter
.Resize(, 1).Offset(, 1).EntireColumn.Delete Shift:=xlToLeft '<-- delete the "2nd" column (i.e. one column offsetted to the right)
End With
End If
End With
Next currIndex
End Sub
there were two faults in your "inherited" code:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For was to be referred to abcDateRow index row instead
the formatting would be applied to all cells, were they filtered (matching) or not

Related

Target formula VBA

I'm running VBA to fill in all cells using last row last col. But my VBA fills in from B3 and until last row, and then adds a line below the last row and fills in to last col.
The code looks like this:
Sub RUNFILL()
With Worksheets("Sheet3").Range("B3")
Set Target = .Range(.Cells(1, Columns.Count).End(xlToLeft), Cells(Rows.Count, "A").End(xlUp))
Target.FormulaLocal = "=INDEKS(Sheet1!$N:$N;MATCH(Sheet3!$A:$A&Sheet3!B$1;Sheet1!$R:$R;0))"
End With
End Sub
I'm not sure why it fills in that way, so I'm hoping that someone can see the problem and help me correct it.
Consider that
Worksheets("Sheet3").Range("B3").Range("A1")
is equivalent to
Worksheets("Sheet3").Range("B3")
and that
Worksheets("Sheet3").Range("B3").Range("C5:D10")
is equivalent to
Worksheets("Sheet3").Range("D7:E12")
Your
With Worksheets("Sheet3").Range("B3")
Set Target = .Range(...)
End With
is equivalent to
Set Target = Worksheets("Sheet3").Range("B3").Range(...)
which is why you are not setting it to the area you think you should be.
But I have no idea why Worksheets("Sheet3").Range("B3").Cells(1, ActiveSheet.Columns.Count) (the expanded equivalent of .Cells(1, Columns.Count) in your code) is not crashing out, as that is (assuming Sheet3 is active) equivalent to Cells(2 + 1, 1 + Columns.Count) which will give a 1004 error due to referencing a column beyond the right-hand limit. (And does give that error when I try to run your code.)
And I also have no idea why your code is filling in column B to the last row (but no other columns after B) and is then inserting one extra line (not two) below that which does extend beyond column B.

Excel VBA deleting certain rows with certain conditions

I found a code online which works but I am failing to change it for my purpose. Each entry in my spreadsheet contains different formulas as well as an Iferror function with the aim of making cells with error messages appear as blank. For example lets say a cell E3 is dependent on cell F3 with a certain formula (for clarification lets say F3/2.5). It is obvious if there is no entry in cell F3 then an error message would display in cell E3. For this reason, I use the IFERROR function to display the cell as blank. The difficulty arises when I want to delete blank rows after a click on the macro button. However, since that cell does have an entry (a formula which in turn returns an error message), that cell does not delete. Also I need to run this code over 3 different selection ranges. Please can someone help! The code I found was from a different thread on this forum and is:
`sub foo()
dim r As Range, rows As Long, i As Long
Set r = ActiveSheet.Range("A1:Z50")
rows = r.rows.Count
For i = rows To 1 Step (-1)
If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
Next
End Sub`
Thanks Alot!
EDIT: If statement added to the autofilter as it was deleting a row when there were no blanks
You will want to set up a column in the spreadsheet with the following sumproduct:
=SUMPRODUCT((LEN(A1:F1)>0)*1)
This is calculating how many cells' values have a length more than 0 hence are not blank, you will need to adjust cell references accordingly as I tested on a small sample of fake data.
Following this you can just loop:
For i = rows To 1 Step (-1)
If Cells(i,"G") = 0 Then r.rows(i).Delete 'My formula is in column "G"
Next
Or set up an auto-filter and delete entire rows of the visible cells:
Dim lrow As Integer
If Not WorksheetFunction.CountIf(Range("G:G"), "0") = 0 Then
Range("A1:G1").AutoFilter
Range("A1:G1").AutoFilter Field:=7, Criteria1:="0"
lrow = Cells(rows.Count, 7).End(xlUp).Row + 1
Range("G2:G" & lrow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range("A1:G1").AutoFilter
End If
The only problem with using a leading column to calculate for this is if you have a lot of data coming and going as you will need to replenish the formula, though you could use auto complete in the code i guess.

Excel VBA code for MID/Splitting text in cell based on fixed width

I apologize if there is already the same question asked elsewhere with an answer however I have been unable to find it so here I go.
I will also mention that I am a VBA beginner, mostly playing around with codes obtained from other people to get what I want.
I currently have data in Columns A-D, with the information in column C being the important column. Everything else should be ignored.
I have a line of text in cell C1 of sheet1. It is 25 characters long and resembles the following:
4760-000004598700000000000
I have over ~970,000 rows of data and need to pull out the information found within each of these cells into two different cells in another sheet.
I cannot simply use a formula due to the number of records (excel crashes when I try).
If using the mid function for C1, I would enter something like (C1,2,3) and (C1,5,11). (except it would be for each cell in column C)
The leading zeroes between the + or - and the beginning of the first non-zero value are of no consequence but I can fix that part on my own if need be.
Ideally the information would be pulled into an existing sheet that I have prepared, in the A and B columns. (IE:sheet2)
For example, using the text provided above, the sheet would look like:
A|B
760|-0000045987 or -45987
I have looked into array, split and mid codes but I had troubles adapting them to my situation with my limited knowledge of VBA. I am sure there is a way to do this and I would appreciate any help to come up with a solution.
Thank you in advance for your help and please let me know if you need any additional information.
It sounds like what you're after could be achieved by the Text to Columns tool. I'm not sure whether you're trying to include this as a step in an existing macro, or if this is all you want the macro to do, so I'll give you both answers.
If you're just looking to split the text at a specified point, you can use the Text to Columns tool. Highlight the cells you want to modify, then go to the Data tab and select "Text to Columns" from the "Data Tools" group.
In the Text to Columns wizard, select the "Fixed Width" radio button and click Next. On step 2, click in the data preview to add breaks where you want the data to be split - so, in the example you gave above, click between "760" and "-". Click Next again.
On step 3, you can choose the format of each column that will result from the operation. This is useful with the leading zeroes you mentioned - you can set each column to "Text". When you're ready, click Finish, and the data will be split.
You can do the same thing with VBA using a fairly simple bit of code, which can be standalone or integrated into a larger macro.
Sub RunTextToColumns()
Dim rngAll As Range
Set rngAll = Range("A1", "A970000")
rngAll.TextToColumns _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(3, 2))
With Sheets("Sheet4").Range("A1", "A970000")
.Value = Range("A1", "A970000").Value
.Offset(0, 1).Value = Range("B1", "B970000").Value
End With
End Sub
This takes around a second to run, including the split and copying the data. Of course, the hard-coded references to ranges and worksheets are bad practice, and should be replaced with either variables or constants, but I left it this way for the sake of clarity.
How about this:
Sub GetNumbers()
Dim Cel As Range, Rng As Range, sCode As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Rng = Sheets("Sheet1").Range("C1:C" & Sheets("Sheet1").Range("C1048576").End(xlUp).Row)
For Each Cel In Rng
Sheets("Sheet2").Cells(Cel.Row, 1).Value = Mid(Cel.Value, 2, 3)
sCode = Mid(Cel.Value, 5, 11)
'Internale loop to get rid of the Zeros, reducing one-by-one
Do Until Mid(sCode, 2, 1) <> "0" And Mid(sCode, 2, 1) <> 0
sCode = Left(sCode, 1) & Right(sCode, Len(sCode) - 2)
Loop
Sheets("Sheet2").Cells(Cel.Row, 2).Value = sCode
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I think there's an array formula thing that would do this, but I prefer the brute force approach. There are two ways to fill in the fields, with a procedure or with a function. I've done both, to illustrate them for you. As well, I've purposely used a number of ways of referencing the cells and of separating the text, to illustrate the various ways of achieving your goal.
Sub SetFields()
Dim rowcounter As Long, lastrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 'get the last row in column "C"
For rowcounter = 1 To lastrow 'for each row in the range of values
'put the left part in column "D"
ActiveSheet.Range("D" & rowcounter) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, True)
'and the right part in the column two over from colum "C"
ActiveSheet.Cells(rowcounter, 3).Offset(0, 2) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, False)
Next rowcounter
End Sub
Function FieldSplitter(FieldText As String, boolLeft As Boolean) As String
If boolLeft Then
FieldSplitter = Mid(FieldText, 2, 3) 'one way of getting text from a string
Else
FieldSplitter = Left(Right(FieldText, 16), 5) ' another way
End If
'Another useful function is Split, as in myString = Split (fieldtext, "-")(0) This would return "4760"
End Function

Excel: Copy and insert rows on another sheet based on cell

I'm trying to make a code that checks for numbers in a master sheet called All in column D (ex. 780101) and if it meets the criteria, it copies the whole row and inserts (not paste) it to another sheet with the name of the criteria (ex. 780101), starting on row 6.
The code I have doesn't work like I want it to. It doesn't copy all the rows that meet the criteria and sometimes it inserts blank rows.
Sub Insert()
For Each Cell In Sheets("All").Range("D:D")
If Cell.Value = "780101" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow + 1).Select
Selection.Copy
Sheets("780101").Select
Rows("6:6").Select
Selection.Insert Shift:=xlDown
End If
Next
End Sub
I'm just starting to learn VBA, so if it could be possible the names of the sheets would be the criteria of the cell values (the code is made for only one sheet - 780101, but there are 20 of sheets with different names).
It's tough to make recommendations without seeing sample data and what could potentially be causing the problems you are having but you can run this rehash of your existing code.
Sub Insert()
Dim dc As Range
With Sheets("All")
For Each dc In Intersect(.Range("D:D"), .UsedRange)
If dc.Value2 = 780101 Then
dc.Resize(2, 1).EntireRow.Copy
Sheets("780101").Rows(6).Insert Shift:=xlDown
End If
Next
End With
End Sub
The nature of running that from top to bottom means that the results will be reversed. You may wish to consider running the main loop from bottom to top to maintain the order.

VBA Go to last empty row

I have a project on excel macro, I need to highlight the next last row that has an empty value. example cell A1:A100 have data and the next cell is A101 is empty.
when user click a button it should highlight the cell A101...
If you are certain that you only need column A, then you can use an End function in VBA to get that result.
If all the cells A1:A100 are filled, then to select the next empty cell use:
Range("A1").End(xlDown).Offset(1, 0).Select
Here, End(xlDown) is the equivalent of selecting A1 and pressing Ctrl + Down Arrow.
If there are blank cells in A1:A100, then you need to start at the bottom and work your way up. You can do this by combining the use of Rows.Count and End(xlUp), like so:
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Going on even further, this can be generalized to selecting a range of cells, starting at a point of your choice (not just in column A). In the following code, assume you have values in cells C10:C100, with blank cells interspersed in between. You wish to select all the cells C10:C100, not knowing that the column ends at row 100, starting by manually selecting C10.
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlUp)).Select
The above line is perhaps one of the more important lines to know as a VBA programmer, as it allows you to dynamically select ranges based on very few criteria, and not be bothered with blank cells in the middle.
try this:
Sub test()
With Application.WorksheetFunction
Cells(.CountA(Columns("A:A")) + 1, 1).Select
End With
End Sub
Hope this works for you.
This does it:
Do
c = c + 1
Loop While Cells(c, "A").Value <> ""
'prints the last empty row
Debug.Print c