Save date criteria with excel VBA - vba

I'm trying to save an autofilter, to then do some things on my worksheets and re-apply the filter.
Following this topic : In Excel VBA, how do I save / restore a user-defined filter? ; it was about to work.
Then I tried to filter on a date column, and it doesn't works -->
It gives me the following error :
I've looking for hours on internet to found a solution, like the following post: Excel VBA Saving autofilter settings with dates; but I can't fix this problem...
I was also thinking about convert the entire column in number format, but it doesn't works as the hide cells are not converted and the filter doesn't convert the value in the filter list.
It seems like dates are not valid values to give for a Criteria1.. could it be?
Here is my code:
With myCurrentWorkbook.Worksheets(my_Of_To_Produce_Sheet).AutoFilter
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1 'it's on this line that it doesn't work
'I tried this solution found on internet
'filterArray(f, 1) = Replace(.Criteria1, Application.International(xlDecimalSeparator), ".")
If .Operator Then
filterArray(f, 2) = .Operator
If .Operator = xlAnd Or .Operator = xlOr Then
filterArray(f, 3) = .Criteria2
End If
End If
End If
End With
Next f
End With
End With

Related

Column format converted to Number, but showing as text

Ive a sheet which is generated using ADO select statement from another sheet. So I have to manually set some formatting. So here is the way I did.
With ThisWorkbook.Sheets("Invoice")
.Columns(1).Resize(.Rows.count - 1, 1).Offset(1, 0).NumberFormat = "yyyy-mmm"
.Columns(6).Resize(.Rows.count - 1, 1).Offset(1, 0).NumberFormat = "dd-mm-yyyy"
.Columns(10).Resize(.Rows.count - 1, 1).Offset(1, 0).NumberFormat = "0.00"
End With
Here column 1 and 6 am converting into two date formats. and column 10 I need to convert into Number format. But 1 and 6 converts fine. But 10 still showing as text and so alligned on left side. Screen grab disabled on our PC, otherwise I could share my actual screen. Hope its clear.
You need to parse it as General first using TextToColumns then apply your formatting. Something like below should work:
With .Columns(10).Resize(.Rows.count - 1, 1).Offset(1, 0)
.TextToColumns Destination:=.Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1)
'DataType:=xlDelimited, _
'FieldInfo:=Array(1, 1)
.NumberFormat = "0.00"
End with
Or as #Whome commented, if it is all numbers, then you can simply:
With .Columns(10).Resize(.Rows.count - 1, 1).Offset(1, 0)
.Value2 = .Value2
.NumberFormat = "0.00"
End with
Edit1: Explained 1st code above. Using .Range("A1") as destination takes advantage of the Range.Range notation in Excel VBA. This means that you can re-index (not sure if this is the right term) a Range using Range Objects Range method. For example:
Dim r As Range: Set r = Range("B1:C10")
Debug.Print r.Range("A1").Address '/* this gives you $B$1 */
Degug.Print r.Range("B5").Address '/* this gives you $C$5 */
Illustration:
And applying that logic in your example:
.Columns(10).Resize(.Rows.count - 1, 1).Offset(1, 0) '/* refers to J2:J1048576 */
And Range("A1") of that range (or Cells(1) as Jeeped commented) is $J$2.
For your second inquiry, please refer to #Jeeped's comment:
"Sandeep brings up a valid point with his second inquiry. If you aren't going to force all delimiter parameters to false, perhaps DataType:=xlFixedWidth, FieldInfo:=Array(0, 1) would be better. You never know what has been left by the user in terms of TextToColumns delimiter(s) parameters."

How to make Excel VBA to ignore formula cells with if condition

I want to use if condition to perform ClearContents task. Please find my below code for the same. I written below 2 code's, but both are unsuccessful.
First Try
t = 1
Do While Cells(t, 1) <> ""
If Cells(t, 1) <> "=" Then
Cells(t, 1).ClearContents
End If
t = t + 1
Loop
Second Try
t = 1
Do While Cells(t, 1) <> ""
If Cells(t, 1) <> Formula Then
Cells(t, 1).ClearContents
End If
t = t + 1
Loop
Basically, I don't want to delete the cells contain where formulas are available but I want to delete the other data.
As an alternative, there is a method to select all the cells containing constant (non-formula) values.
Cells.SpecialCells(xlCellTypeConstants, 23).ClearContents
Faster than iterating all the cells.
Or to do this only on a specific range or the current selection, replace Cells with Range("A1:A100") or Selection.
(In Excel, you can find this under Home -> Editing -> Find & Select -> Go to Special. Here you can have Excel automatically select only the Constants or the Formulas inside the existing selection.)
Write something like this:
If Not Cells(t,1).HasFormula Then
End if
It would work. Or try like this:
Sub TestMe()
If Not Cells(1, 1).HasFormula Then
Debug.Print "No Formula"
Else
Debug.Print "Has Formula"
End If
End Sub
Here is more info about the .HasFormula property:
https://msdn.microsoft.com/en-us/library/office/ff837123.aspx

VBA using like operator with wildcards

I'm trying to compare address data. My current macro compares two columns and inputs "Dropped Data" when they don't match. The problem is that a large number of these values haven't been dropped but integrated into another cell. I want to change my macro to be able to find the missing value using VBA's like operator. For example it would find "Bldg 3" in "9825 Spectrum Dr Bldg 3". I was able to get this code from looking around the web and I'm not sure what range Range("C65536") is selecting.
Edit: I see people are suggesting I use the Instr function which does seem to do what I want to do. I'm not sure how I would get it to work in my macro/ get it to reference the correct cells. It also (from what I understand) returns values equal to the number of characters found. So in the example I gave it would return a value of 6 if you include the space.
Sub droppeddata()
Application.ScreenUpdating = False
lr = Range("C65536").End(xlUp).Row
For a = lr To 1 Step -1
If Not IsEmpty(Cells(a, 13).Value) And IsEmpty(Cells(a, 19)) Then
Cells(a, 10).Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "N"
Cells(a, 11).Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "Dropped Data"
End If
Next a
Application.ScreenUpdating = True
End Sub
Your current macro doesn't compare anything the way you want it to, it just checks whether or not two columns are empty.
You haven't been very specific with what you are trying to do, so this code is done with a bit of guess-work:
Sub droppeddata()
Dim lr As Long ' Declare the variable
lr = Range("C65536").End(xlUp).Row ' Set the variable
' lr now contains the last used row in column C
Application.ScreenUpdating = False
For a = lr To 1 Step -1
If IsEmpty(Cells(a, 19)) Or InStr(1, Cells(a, 13).Value, Cells(a, 19).Value, vbTextCompare) > 0 Then
' If Cells(a, 19) is empty OR
' Search Cells(a, 13) for the value contained in Cells(a, 19)
' If INSTR returns a match greater than 0, it means the string we're looking for is present
' Enter the loop if either condition is true
' In this section, avoiding SELECT is preferable. Working directly on the ranges is good.
With Cells(a, 10)
.NumberFormat = "General"
.Value = "N"
End With
With Cells(a, 11)
.NumberFormat = "General"
.Value = "Dropped Data"
End With
End If
Next a
Application.ScreenUpdating = True
End Sub
Change the ranges/cells to your need - the current ones aren't meant to work, I merely guessed based on your existing code.

VBA Right-Function returning wrong data type

I have written a very simple code which returns the last 6 characters of every active cell within a range.
The code works pretty good until it finds a particular cell in which the characters to be returned should be: "MARC01". Unfortunately it returns a date type character (01.Mrz).
By using the normal excel formula it works fine, that is why I would expect it to work with a Macro as well.
Here you can see my code which takes the strings from column "A" and enters it in column "B":
Range("B12").Activate
Do
ActiveCell.Value = Right((ActiveCell.Offset(0, -1).Value), 6)
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1).Value = 0
Excel likes to change anything that looks like a possible date to a date. To force this not to happen put a "'" in front of the formula.
ActiveCell.Value = "'" & Right((ActiveCell.Offset(0, -1).value), 6)
This will force it to stay text. The down side to this is, if it is a number it will be saved as text.
Excel likes to try to interpret certain data, rather than just leaving it as is. It especially does that with strings that look like dates, and with numeric entries.
Two ways to workaround are
Put the text prefix character in front of your string. This is usually a single quote. (see Scott's answer for code)
Format the cell as Text before you place the value there.
Sub foo()
Range("B12").Activate
Do
ActiveCell.NumberFormat = "#"
ActiveCell.Value = Right((ActiveCell.Offset(0, -1).Formula), 6)
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1).Value = 0
End Sub
With this simple goal, I don't know why you need VBA looping.
You can just mass set the formular1c1 to =RIGHT(RC[-1],6).
Option Explicit
Sub Right6()
Const R6LeftCol = "=RIGHT(RC[-1],6)"
Dim oRng As Range, lRow As Long
lRow = Cells(Rows.Count, "A").End(xlUp).Row
Set oRng = Range("B12")
Range(oRng, Cells(lRow, "B")).FormulaR1C1 = R6LeftCol
Set oRng = Nothing
End Sub

VBA find cell of closest value

I have an excel file that looks like:
12123 51212
12123.5 45832
12124 37656
12124.5 32987
12125 42445
and so on, where column A is always 0.5 increasing and column B has a certain output.
Now I have a specific value in cell E2, say 12124,23 and I want a VBA code to return, in this case, that the best matching value is in cell A3, because I need this cell location in further code, I don't need the corresponding value in column B. I don't know how to start, however. The file can be up to 30000 rows big.
I'd only like to know first which method to use, then I will try to write the code myself of course :)
JV
You don't have to use VBA for your problem, Excel will do it perfectly fine!
Try this
=vlookup(E2;A:A;2;true)
and for what you are trying to do, you HAVE TO sort your A column in an ascending fashion, or else you will get an error!
And if you do need that in VBA,
a simple for+if structure with a test like this
Function pr24(ByVal Value_To_Match As Double) As Range
For i = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) > Value_To_Match Then
If Abs(Cells(i - 1, 1) - Value_To_Match) >= Abs(Cells(i, 1) - Value_To_Match) Then
pr24 = Range(Cells(i, 1))
Else
pr24 = Range(Cells(i - 1, 1))
End If
Exit For
Else
End If
Next i
End Function
or you can use the worksheet function Vlookup
Application.WorksheetFunction.VLOOKUP()
You could use VLOOKUP function for this:-
Application.WorksheetFunction.VLOOKUP(lookup_value, table_array, column_index, range_lookup)
Set your values as below:-
lookup_value = 12124.23
table_array = would be the range Ax:Bx containing your values
column_index = 2 (the second column of table_array)
range_lookup = true
Setting range_lookup to true means that if the vlookup doesn't find the exact value it will return the closest match.
Note this will only work if the values in column A are sorted in ascending order.
Hope this helps.
You need to sort your data in column A first (smallest to largest), and then you can use a simple lookup formula:
=LOOKUP(E2,A:A)
If you don't want to sort the data, then you can use a VBA loop like so - however this is very inefficient - you should always use worksheet formulas where you can:
Sub SO()
Dim resultCell As Excel.Range
Dim checkCell As Double
Dim bestDiff As Double
checkCell = Range("E2").Value
bestDiff = checkCell
For i = 1 To Range("A" & Rows.count).End(xlUp).Row
If Range("A" & i).Value <= checkCell Then
If (checkCell - Range("A" & i).Value) < bestDiff Then
bestDiff = checkCell - Range("A" & i)
Set resultCell = Range("A" & i)
End If
End If
Next i
MsgBox "Best match is in " & resultCell.Address
Set resultCell = Nothing
End Sub
You dont'need VBA, a call co VLOOKUP Excel function will do the trick; remember to set the last parameter to true, to find a non exact match with the searched value
It should be like something similar to:
= VLOOKUP(E2, A:B, 2, true)