How can I autofilter when I'm not sure which column it will be? - vba

I'm trying to automate the processing of various reports, which I just need to filter and count the rows of. I currently have a PowerShell script that opens each report and runs a few macros. It is just about in a working state, but I'd now like to make it a bit more intelligent and catch some of the fails, so I might be asking a few questions but I'll stick to the one problem on each.
The reports have similar, but not identical layouts. I am looking for a particular column name to then autofilter. I have a very basic and bodged together macro that currently does this, and works (most of the time) for example, sometimes the column I want is A or B:
If Worksheets(1).Range("A1") Like "*word" Then
Worksheets(1).Range("A1").AutoFilter Field:=1, Criteria1:="=criteria1", Operator:=xlOr, Criteria2:="=criteria2"
ElseIf Worksheets(1).Range("B1") Like "*word" Then
Worksheets(1).Range("A1").AutoFilter Field:=2, Criteria1:="=criteria", Operator:=xlOr, Criteria2:="=criteria2"
Hopefully that gives you the current picture.
I now want to instead, do a search for the field header I am looking for, then filter that column, so if the report format in future changes my macro won't break. Something similar to:
ColNum = Application.Match("*header", Range("A:Z"), 0)
ColNumInt = CInt(ColNum)
If ColNumInt > 0 Then
ActiveSheet.Range("A1").AutoFilter Field:=ColNumInt, Criteria1:="=criteria1*", Operator:=xlAnd
End If
But this gives an error "AutoFilter method of Range class failed", Googlefu says to turn off filters but they're already off. So I'm a bit stuck.

This part will always fail:
ColNum = Application.Match("*header", Range("A:Z"), 0)
since match only works on one row or column. So your code is actually returning Error 2042, which is then converted to 2042 by CInt. I guess you don't have that many columns of data, hence the autofilter fails. Use:
ColNum = Application.Match("*header", Range("A1:Z1"), 0)
If Not IsError(ColNum) Then
...
End If

This should work for you.
Sub Button1_Click()
Dim r As Range
Dim c As Integer
Set r = Range("A1:B1").Find(what:="*word*", lookat:=xlWhole)
c = r.Column
ActiveSheet.AutoFilterMode = 0
Columns(c).AutoFilter Field:=1, Criteria1:="*criteria1*"
End Sub

Related

Copying columns including blanks without skipping rows..leave "blanks" blank VBA

Aplication Defined error Copying a specified column and range including blanks with an embedded button running multiple Macros. I know that all rows will be filled in column A so if I could reference the rest of the Macros to A.end
I've looked Google youtube and here although there is a lot of info on copying and pasting, I cannot find one that works for this running multiple Macros.
Macros 5 & 6 is where I start having problems because these columns have multiple blanks throughout.
Raw data to Copy:
Destination:
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("a2") 'macro1
Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("b2") 'Macro2
Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("c2") 'macro3
Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("d2") 'macro4
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
Worksheets("Sheet2").Range("i2").Copy 'macro5
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
Worksheets("Sheet2").Range("j2").Copy 'macro6
Worksheets("Sheet2").Activate 'macro7
Range.end(xldown) only gets you a contiguous range (effectively it will stop at the first blank cell).
Since you want to include blanks, you might want to instead work from the last row of your worksheet back up to the first non-blank cell encountered in that column (which is a way of getting the last row).
This would mean something like:
' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows
With Worksheets("Sheet1")
.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1
End with
Untested, written on mobile -- but hope it works or gets you closer to a solution. You would need to copy-paste the above and change the A to B, C, D, E, etc. I wasn't too sure what you're trying to achieve with the "<0" condition in macro 5 and 6.
(It would better if you turned the code into a parameterised Sub and just provide the column letter/number as an argument to the sub, but just depends how new you are to VBA and programming in general -- and for the time being whatever is easier for you to understand/maintain.)
Edit regarding macro 5 and 6
With Worksheets("Sheet1")
Dim cell as range
For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'
Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5
ElseIf cell.value > 0 Then
Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If
Next cell
End With
Worksheets("Sheet2").Activate 'macro7

Microsoft Excel: Macro to repeat a specific action multiple times

My task is to use Excel to manipulate a large set of data and I had heard of using a Macro but I'm not very code-savvy. I recorded the steps that are required using the macro function, but I need to add more lines of code to utilize looping and making sure it advances by 2 after every repeat.
I've posted my steps below:
Range("A5:C5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A5").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
Range("B7:C7").Select
Selection.Copy
Range("B5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Basically, select 3 cells (A5:C5) insert cells and shift cells down. Use a formula in the newly empty A5 to add 0.1 to A4 and copy values from B7:C7 and paste into B5:C5.
The following image shows a before and after of what I'm talking about to make things more clear.
Before
After
The next step would be:
Range("A7:C7").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A7").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
Range("B9:C9").Select
Selection.Copy
Range("B7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
and so on.
Any help with this would be greatly appreciated. I also apologize if what I'm asking is still confusing or not clear in any way.
[Prologue:]
Hi, I'll provide you with an answer and I tried to comment the heck out of it to make it as beginner friendly as possible, but the truth of the matter is:
I can explain to you how it's done, but you will never properly understand why it's done until you properly understand basic programming methodologies such as looping and that is something only you and you alone have to sit down to and fully comprehend
[The gaps in logic:]
Probably the biggest issue is, you have not specified what happens
when your data reaches empty cells (what I mean under that) - if in
your loop you were on row 10 (7, M, N) you would have no longer any
letters to add, as the next 2 rows (12) no longer contain eny data.
Given this, I modified the loop to start at the n-2th row instead to prevent this from happening (that means in your example it will end (or start to be more precise) at 6.1 as it's the last row that can retrieve the data)
In general, I'd recommend posting not only a picture of input data, but rather than picture of current result in this case a properly explained expected result would be much more to our benefit and understanding and would have saved me a lot of the guesswork here.
[The theoretical part of your question:]
I'll save you a bit of googling time here with few useful facts.
If you're looking to repeat a specific action, you should always be looking to utilize one of the 2 (or 3 depending on how you classify them) loops for and do (while/until)
Better yet, if you're looking to loop a variant amount of actions for repeated amount of times, you should utlize either a procedure Sub or a function Function so you can use arguments that act as a variable for the loop.
Generally when adding or removing rows it's important to loop from Bottom to Top (from Last to First). Why? Because if you add an extra row, it's going to mess up your Row order.
With all that in mind, the procedure itself could look something like this:
[The solution itself:]
You can use the following procedure every time for a specified range.
Option Explicit 'prevents typo. errors, undeclared variables and so on
Private Sub extra_row(ByVal rng As Range) 'declaration of procedure
Dim i As Long
' we loop for the n-th - 2 row (last row - 2) to the pre-first (added) row.
For i = (rng.Rows.Count + rng.Row - 2) To rng.Row + 1 Step -1
'why the -2? ^ Because if you add the letters from next 2 rows,_
the last 2 would have no to grab _
eg. Row 10 and 11 in your original data would have no data under them to grab
' a bit harder section to comprehend, if it's the first data entry _
we need to account for the fact that we have not added any extra rows yet_
hence we also need to decrement the row from which we receive the data by 1 _
it 's bit of difficult to word, i'd highly recommend debugging yourself _
and seeing what happens with or without it
Dim fp As Integer
If (i - 2 = rng.Rows.Count) Then
fp = 1
Else
fp = 0
End If
' now we just add the extra rows where we can
Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 1) = Cells(i, 1).Offset(-1, 0) + 0.1 'we add 0.1 to cell one above
Cells(i, 2) = Cells(i + 3 - fp, 2) ' similar case, with letters, but two below
Cells(i, 3) = Cells(i + 3 - fp, 3) ' similar case, with letters, but two below
Next i 'and we loop for every cell in our specified range
End Sub
Eg. in your case, you could run the procedure with the following command:
Call extra_row(Range("A4:A11"))
[Practical use]
While the solution itself should work, in a real world example it probably might be smarter not to use a specific range to call for each procedure. Especially if that means use has to look at the worksheet, check the range and count the rows manually.
That's one of the reasons we created a procedure here to begin with. So I created one more procedure akin to main() in most programming languages which detects the last active row and applies the procedure to your data range by detecting it automatically.
So in the end, your could should look something like this:
Option Explicit
Private Sub extra_row(ByVal rng as Range)
'... code from the answer here
End Sub
Private Sub rundata()
Dim lr As Long
lr = Sheets("Your Sheet Name").Cells(Rows.Count, 1).End(xlUp).Row
'detects the last active (nonempty) row _
rememeber to change the Sheets("") to wherever your data is stored
Dim mydata As Range
Set mydata = Range("A4:A" & lr) 'under presumption your data always begins with A4
Call extra_row(mydata)
End Sub
Now, whenever you would run (manally) or Call the run_data() procedure it would automatically detect the range and apply the procedure we defined to it.
[Expected result visualization and closing words:]
We started with this:
After running the procedure:
Now I know, it may seem like there's a lot of novel concepts here, but truth of the matter is, all of them are fairly easy once you buckle down and try to comprehend the code line by line. Most of it is simple mathematical operations.
If you still have trouble comprehending anything here, do your own research first and then post comment here or better yet, create a new question (if it warrants it).
Good luck on your coding journey! :)
Rawrplus
This code should do the trick.
The code gives you an InputBox in which you can type in the number of times to run the code.
Sub test()
Application.ScreenUpdating = False
Dim Grab As Range
Dim RunTimes As Long
On Error GoTo Get_Out
RunTimes = InputBox("How many times shall the code run?", "Run times")
On Error GoTo 0
For x = 1 To RunTimes * 1.5 + 3 Step 2
Set Grab = ActiveSheet.Range("A" & x + 4)
Grab.EntireRow.Insert
Grab.Offset(-1, 0).Value = Grab.Offset(-2, 0).Value + 0.1
Grab.Offset(-1, 1).Value = Grab.Offset(1, 1).Value
Grab.Offset(-1, 2).Value = Grab.Offset(1, 2).Value
Next x
MsgBox "Succes"
Get_Out:
Application.ScreenUpdating = True
End Sub
Let me know if you have any questions about the code or if you want me to explain it further :)

Autofill in Excel VBA returns error 1004

I am trying to get a raw Excel file into a customized format. I added a picture below, so its easier to explain. I will address the requirements as steps too.
1) I need to get rid off all columns which include "Importo" or "Prezzo"
2) I need to extract the date from the remaining columns (Quantitá). First, I insert an empty row on top and then i apply right(cell,7).
So far, so good.
Then I want to autofill the remaining columns, but i get a 1004 error. In the example code I tried from J:O, but really id need it from J to the last column. I post the code (which works until the last row).
I was actually wondering if Autofilling is best practise here, maybe indexing though would be better?
Sub delete_col()
Dim A As Range
Do
Set A = Rows(1).Find(What:="Importo", LookIn:=xlValues, lookat:=xlPart)
If A Is Nothing Then Exit Do
A.EntireColumn.Delete
Loop
Do
Set A = Rows(1).Find(What:="Prezzo", LookIn:=xlValues, lookat:=xlPart)
If A Is Nothing Then Exit Do
A.EntireColumn.Delete
Loop
Rows("1:1").Select
ActiveCell.EntireRow.Insert
ActiveCell.Range("J1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(R\[1\]C,7)"
Selection.AutoFill Destination:=ActiveCell.Range("J1:O1"), Type:=xlFillDefault
End Sub
I suppose that in the line ActiveCell.FormulaR1C1 = "=RIGHT(R\[1\]C,7)", the \ is a kind of typo, which should be deleted.
Concerning the 1004 error, the easiest way to go around it, while doing AutoFill, is something like this:
Sub TestMe()
Range("A1:O1") = Range("J1")
End Sub
Thus, every value in Range("A1:O1") will be set with the value from Range("J1").
However, your code uses a lot of Select, Activate and ActiveCell. Try to avoid these, because they are not considered good practices in VBA and may lead to different errors. How to avoid using Select in Excel VBA

Only some lines throwing "Object variable or with variable not set" error when using .Find method

(I know this sounds like a repeat question, but I've searched everywhere for this, and I couldn't find anything about this)
I'm trying to automate a tax filing process at work. Essentially, I'm reading off several worksheets and populating relevant fields into a master mapping sheet. However (and this is the strange part), when I first coded everything out, there were no errors and I managed to find everything. After saving and reopening the workbook though, I keep getting this error and only for certain lines (9 occurences out of the 57 times I call the .find method in total).
I know the error means that the .find method couldn't find what I was looking for, but I know the field exists since it worked perfectly well before I closed and reopened the workbook, and it works for the rest of the searches. Does anyone have any ideas?
I've checked my macro security settings (everything is enabled), and I know the .find method isn't retrieving anything (I put in "if ___ is nothing" statements to verify, and the affected lines all return nothing when called), but I know the fields I'm searching for exist in their respective sheets.
Here's one of the lines throwing the error:
Range("C7").Select
Set currentRowReference = Worksheets("Stat A").Range("B1:B999").Find("Current year tax losses", LookIn:=xlValues, lookat:=xlPart)
firstCalculation = Worksheets("Stat A").Cells(currentRowReference.Row - 2, "E")
Set currentRowReference = Worksheets("Stat A").Range("A1:A999").Find("Unabsorbed capital allowances c/f", LookIn:=xlValues, lookat:=xlPart)
secondCalculation = Worksheets("Stat A").Cells(currentRowReference.Row - 1, "E")
ActiveCell.FormulaR1C1 = firstCalculation - secondCalculation
Any help or ideas will be much appreciated!
Edit: I've added a larger portion of my code, and a screenshot of the sheet it's supposed to read from. In the code above, firstCalculation successfully computes, while secondCalculation throws the error.
Screenshot of source sheet. Specifically, it's supposed to read A31
since you have to deal with merged cells, you'd better use a function on your own like the following:
Function MyRowFind(rng As Range, textToFind As String) As Long
Dim cell As Range
MyRowFind = -1
For Each cell In rng.SpecialCells(xlCellTypeConstants, xlTextValues)
If InStr(cell.value, textToFind) > 0 Then
MyRowFind = cell.Row
Exit Function
End If
Next cell
End Function
to be used in your main sub as follows:
Sub main()
Dim currentRowReferenceRow As Long
currentRowReferenceRow = MyRowFind(Worksheets("Stat A").Range("A1:A999"), "Unabsorbed capital allowances c/f")
If currentRowReferenceRow > 0 Then
' code
End If
End Sub

Two methods of selecting sheet2 and finding the last used row using a command button in sheet1 both fail

I have been trying to select Sheet2 from Sheet1 using a command button click macro. The final part of the macro is designed to find the last used row (offset by 1) and return the row number using MsgBox. I have tried two methods of selecting sheet2. However, in both cases the number returned by MsgBox is the last used row of sheet1, not of sheet2. I know this because when I change the last cell in column A that contains data (i.e. place data in a different cell), the MsgBox provides the new value (offset by 1).
I guess the error may be in my usage of Cells.Find. I know that there are several possible methods of determining the last used row but from what I’ve read the Cells.Find method is the most reliable. The only obvious thing to me is that the row number returned is from Sheet1, not Sheet2. There are no error messages associated with this failure.
The first method is:
Private Sub CommandButton1_Click()
Set wSheet = Worksheets("Sheet2")
wSheet.Activate
With wSheet
unusedRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Offset(1, 0).Row
End With
MsgBox (unusedRow)
End Sub
The second method is:
Private Sub CommandButton1_Click()
Application.Goto Reference:=Worksheets("Sheet2").Range("A1"), Scroll:=True
unusedRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Offset(1, 0).Row
MsgBox (unusedRow)
End Sub
Can anybody comment on any errors in my code? Any help would be greatly appreciated. I am very much a learner of XL VBA.
Edit: Response to comments
Thanks a lot #Dan; I have read both of those works you referenced. There is another useful discussion I found that I will dig out the link for and put here. I think I'm not yet tuned to the syntax at even a fairly fundamental level, so some of the more subtle variations are still a bit obscure. But I have got the point about avoiding select etc although I can only get there sometimes. I guess that's because I quite often use the macro recorder which tends to use the select family.
Many thanks #Tony - that's the piece of information I needed - the macro works fine now and I understand things a little better. Yes, I did run it with the Activate statement included and it gave me the last used row (offset by 1) for Sheet1; with your revision I get that row number for Sheet2. Thanks again.