Formatting date columns as text using VBA - Question - excel

The problem: the dates displayed in my excel files are not the actual dates entered into each cell. For example, I might visually see 04/18/2019 but when I click on the cell, it shows 04/18/2019 06:48:00PM. This becomes an issue when I run the macro I use to convert my xlsx file to txt. The txt file generated will show 04/19/2019 06:48:00PM in the date field rather than what I want, 04/18/2019.
The current fix I'm using is to insert columns next to the date columns, copy the date columns and paste values into the new inserted columns, and then deleting the inserted columns. This was accomplished through recording a macro (I'm a noob if you couldn't tell).
That rudimentary fix does actually work quite well at generating the output I need. Except one problem: if there are any blanks in the date columns, it pastes in 01/01/1900. Blanks in date columns is fairly common in the work I do so this is a major problem.
I tried adding this If in after the inserting/pasting values/deleting code:
'Fix Date format in columns A and C
'
Columns("B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""mm"/"dd"/"yyyy"")"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""mm"/"dd"/"yyyy"")"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B" & EndRow)
Range("E1").Select
Selection.AutoFill Destination:=Range("E1:E" & EndRow)
Range("B1:B" & EndRow).Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E1:E" & EndRow).Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
If Range("A1:A") = "01/01/1900" Then ClearContents
'
But I get this error "Compile Error: Sub or Function not defined", with the word Range within the If statement highlighted. I don't understand why it isn't recognizing range since it is used just a few lines up without issue. I have to be doing something wrong but I'm lost. Any ideas?
PS - The If is just a means to an end as far as remedying the blanks, but I'm sure there's a better way to convert these date columns to text or to the date format I want. If you have any recommendations for some easier way to achieve the same results I am all ears.
Thanks guys I really appreciate it!

Range("A1:A")
That's a google-sheets reference for 'everything from A1 down to the last used cell in column A' not a VBA style. Either reference the entire column (e.g. Range("A:A")) or modify the end row with your EndRow var (e.g. Range("A1:A" & EndRow)).
The formating mask used in the VBA application of the TEXT formula seems wrong. When using a quote within a quoted string,double up the quote once every time it ix used. The TEXT formula returns a string (i.e. text); you do not need to attempt any further conversion.
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""mm/dd/yyyy"")"
Both xlR1C1 and relative styled xlA1 formulas be applied to all cells at once. A Union of the target cells in columns B and E further expedites the formula insert.
Range("B1:B" & EndRow & ",E1:E" & EndRow).formular1c1 = "=TEXT(RC[-1],""mm/dd/yyyy"")"
You cannot directly compare a multiple cell range to a single value. Either loop through the cells or use a wide-range comparison like Range.Find, the worksheet's MATCH function or an AutoFilter to expose the matching cells as xlCellTypeVisible.
dim m as variant
m = application.match("01/01/1900", ActiveSheet.Range("A:A"), 0)
do while not iserror(m)
ActiveSheet.Cells(m, "A").clearcontents
m = application.match("01/01/1900", ActiveSheet.Range("A:A"), 0)
loop
If you've read down this far, the easiest method of stripping the date out of a date-time is Text-to-Columns. Simply discard anything after the 10th character (e.g. mm/dd/yyyy from mm/dd/yyyy hh:mm amp/pm).
With ActiveSheet.Columns("A")
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(10, 9))
.NumberFormat = "mm/dd/yyyy"
End With
I would humbly suggest you take some time to investigate How to avoid using Select in Excel VBA. If you continue to develop VBA to make your Office applications more efficient, you should start using recommended methods as soon as possible.

Related

Loop by criteria

Can anyone helps me please, I'm newbie to using macro :)
I want to loop my macro by criteria, ex : criteria 1 & 2
in this case I just define 2 criteria, and some case I have 20 criteria
So I want to filter criteria 1, and I copy some rows & column and make new file and save to specific folder and the name same with the criteria, and I want to repeat it with different criteria and different name file.
Filter I want to loop
This is my Code, I hope someone can help me,
Sub Converter()
Sheets("SHEET INPUT").Select
ActiveSheet.Range("$A$2:$AQ$4652").AutoFilter Field:=22, Criteria1:="<>"
ActiveSheet.Range("$A$2:$AQ$4652").AutoFilter Field:=5, Criteria1:="1"
Range("W2:AQ2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Columns.AutoFit
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "m/d/yyyy"
Range("N1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "m/d/yyyy"
Range("R1").Select
ActiveWorkbook.SaveAs Filename:="C:\Users\BJ900265\Documents\Z-Spam File\Converter Temap\PO 1.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub
I've seen several tutorials and I can't found what I want
I would suggest not using excel filter but filtering in own loop while/for. I'm also newbie so this approach is based on low experience, but I can imagine it being easy to write. U can easily control number/name of criterias/WB then.
I can give you the whole idea of a loop. For the details you just have to put anything you wrote inside the loop.
You can use any kind of loop (Do-While/Do-Until/For) To this purpose. I would suggest For Loop:
First you have to count how many times your For Loop wants to be repeated, in this case it seems to be number of rows in your desired column (Criteria).To count number of rows in your desired column you can make a Range of Cells under your column header (Criteria) then Count number of this Range cells.
Let's say the column you want to count number of cells bellow is Trigger CPS 1, Then you can count the cells below it this way:
ActiveSheet.Range(Range("A3"),Range("A3").End(xlDown)).Cells.Count
So To this point you have your i value for your For Loop:
All you have to do is to put your Selecting, Copying and Pasting operations inside this loop.

Need to switch over an index formula into VBA to allow me to return true blanks

I have a spreadsheet that takes data from reports. Sometimes there can be 4 numbers included and other times 50 relevant numbers.
Using XLookup with all the potential labels, and returning numbers if in the imported report.
Currently using this formula to scrub the data free of irrelevant number & label.
=IFERROR(INDEX(DATA!C:C,SMALL(IF(DATA!D:D<>0,ROW(DATA!D:D)),ROWS(DATA!$D$2:D3))),"")
However, when I copy and paste in VB using:
Sheets("CALC").Select
Range("W3:W9" & Range("W1").End(xlDown).Row).Select
Selection.Copy
Sheets("FORM (3)").Select
Range("B20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
I get the cells not filled in, that potentially could've been filled in, as blank but not true blanks.
Added this in afterwards and it looks like it did a quick fix for me.
Range("B20:L80").Select
For Each cell In Selection
If cell.Value = "" Then
cell.ClearContents
End If
Next

Search column for string text with numbers then use =mid to extract 2 numbers

I am very new to recording macros and being able to edit the recorded macro to a more generalized state so that the macro can be run on different spreadsheets.
I am sorry if this has been answered before, I did search but as you can see from my title, I am having some difficulty explaining what I am trying to do.
updated screenshot
As you can see, I have mixed data in Column A, whereas I would like to have just the two numbers to the left of the "-". I have used =MID(A9,17,2) to get the desired result which is 02, however, it is not guaranteed that the data will always be in A96 as these are exported summary reports of individual matters. I should also mention that the string data will always be the same length but not the same "name" SE2013000123.00002-1.
After the mid formula is run, I need to apply the formula to all cells which have the string in it.
I have recorded a macro but am at a loss as to what I need to take out and how to search based on a variable data search (is that the correct terminology?).
Option Explicit
Sub Test2()
'
' Test2 Macro
'
'
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B96").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-1],17,2)"
Range("B97").Select
End Sub
Sub Value()
'
' Value Macro
'
'
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
As text-that-looks-like a number,
with worksheets("Sheet1")
.Range(.cells(96, "B"), .cells(.rows.count, "A").end(xlup).offset(0, 1).Formula = "=MID(A96, FIND(CHAR(45), A96)-2, 2)"
end with
As a true number,
with worksheets("Sheet1")
.Range(.cells(96, "B"), .cells(.rows.count, "A").end(xlup).offset(0, 1).Formula = "=--MID(A96, FIND(CHAR(45), A96)-2, 2)"
end with

VBA copying cell dependent on text to next blank cell on another worksheet

I created the below and i'm an absolute noob, i literally just pieced different bits of info together to get it working and it did, until i added the selecting the cell if it has 'r' in it and moving it to 'sheet7' and now i get an (object required) error when it runs.
I really need some help on this and if you are feeling generous, i would like to repeat the exercise with several other letters and sheets, so if you could demonstrate an additional one too, i'm sure i could work out the rest.
Thanks in advance
Sub Macro1()
'
' Macro1 Macro
'
'
Range("I16").Select
Selection.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Application.CutCopyMode = False
Selection.Copy
Range("J20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-27
Range("I16").Select
If Cell.Value = "R" Then
Range("J20").Select
Selection.Copy
Sheets("Sheet7").Select
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Generally when writing macros it's good practice to avoid selecting cells. Selecting a cell is really something that only a human does, but in VBA we can just refer to the cell directly without touching it.
Rewriting your macro to avoid all the touching:
Sub Macro1()
'Make a variable to store the cell found
Dim lastCell as Range
'find the last cell in Column A of the active sheet
lastCell = Range("A" & Rows.Count).End(xlUp).Offset(1)
'Paste in the I16 value
lastCell.value = RangE("I16").value
'Grab whatever is hanging out in Column B next to the last cell and stick it in J20
Range("J20").value = lastCell.Offset(0,1).value
'Test to see if I16 has value "R"
If Range("I16").value = "R" Then
'Find the last row in Sheet7, Column B and store it to the variable
lastCell = Range("B" & Rows.Count).End(xlUp).Offset(1)
'Copy J20 value to the lastCell in Sheet 7, Column B
lastCell = Range("J20").value
End if
End Sub
I'm not sure where you were getting the error you reported. It's probably specific to your workbook, so we'd have to be sitting in front of it to track it down. This rewrite may correct it though.
Also, it's not clear what else is happening in this process. My guess is that Column B of the Active Sheet has a formula in it that does something to the value we paste from I16. After it's pasted and calculated we grab that and stick it in J20 and if I16 is equal to "R" then we put that calculated J20 value over Sheet7. If that sounds about right, then the macro above should do the trick.
Also, if that IS what's happening, then perhaps you could share the formula you have in Column B. We can probable to do that calculation within VBA and save a ton of steps in this macro.

Macro to Auto Fill Down to last adjacent cell

I am trying to use macro recorder in Excel to record a macro to fill down a column of cells, however because the fill down each time is a different number of cells it either fills down to short or too long and this seems to be because the macro identifies the cell range and its fixed.
Is there anyway that I can get it to fill down to the last populated neighbouring cell. E.g. AutoFill down column E until it reaches the last populated row in column D. I have looked at some examples on here but the code all looks very different so not sure if it can be done with macro recorder or I have to get someone to write some code or is it something that has to be done manually?
This is the code that I have in the macro.
ActiveCell.FormulaR1C1 = _
"=IF(MONTH(RC[-1])>3,"" ""&YEAR(RC[-1])&""-""&RIGHT(YEAR(RC[-1])+1,2),"" ""&YEAR(RC[-1])-1&""-""&RIGHT(YEAR(RC[-1]),2))"
Selection.AutoFill Destination:=Range("E2:E1344")
'Selection.AutoFill Destination:=Range("E2:E1344")
Range("E2:E1344").Select
If anyone can help i'd be extremely grateful
Untested....but should work.
Dim lastrow as long
lastrow = range("D65000").end(xlup).Row
ActiveCell.FormulaR1C1 = _
"=IF(MONTH(RC[-1])>3,"" ""&YEAR(RC[-1])&""-""&RIGHT(YEAR(RC[-1])+1,2),"" ""&YEAR(RC[-1])-1&""-""&RIGHT(YEAR(RC[-1]),2))"
Selection.AutoFill Destination:=Range("E2:E" & lastrow)
'Selection.AutoFill Destination:=Range("E2:E"& lastrow)
Range("E2:E1344").Select
Only exception being are you sure your Autofill code is perfect...
This example shows you how to fill column B based on the the volume of data in Column A. Adjust "A1" accordingly to your needs. It will fill in column B based on the formula in B1.
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
ActiveCell.Offset(0, -1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown

Resources