I have an Excel 2010 worksheet which has macros to copy data from other sheets into a specific format on another sheet.
The data copies but I have an issue with the formatting of cell ranges which hold date or time values.
The data originates from a database extract and everything is in text format. In my worksheet when I copy the date (via VBA) I apply the format "yyyy-mm-dd" for dates and "hh:mm.ss.ss" for times.
There is never a fixed amount of rows so I've set the VBA code to apply the formatting to the range of cells for example:
AssDateLastRow = shAss.Range("C" & Rows.Count).End(xlUp).Row
shAss.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd"
Not all cells in the range have the correct format, they will appear as 15/04/2014 not 2014-04-15. If I manually select the cell and press the F2 then ENTER keys the format appears as I need. This happens randomly through the range and there could be thousands of rows so it is not practical to trawl though the worksheet manually hitting F2+ENTER on each one.
I've looked on the internet and found what should automatically do the F2+ENTER with VBA.
The code below is extracted from a larger set of lines of code, so the Dim statements etc. are further up in the actual copy, but this should show the way I've tackled this so far.
Dim shAss As Worksheet
Dim AssDateLastRow As Long
Dim c As Range
'enter method to format 'Date Craftperson Assigned' and 'Time Craftperson Assigned' in Assignments sheet
'column "C" and "D", to formats required by Archibus: date "yyyy-mm-dd", time "hh:mm.ss.ss"
AssDateLastRow = shAss.Range("C" & Rows.Count).End(xlUp).Row
shAss.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd"
'ensure format is applied by forcing F2 edit of cell
For Each c In shAss.Range("C4:C" & AssDateLastRow).Cells
c.Select
SendKeys "{F2}", True
SendKeys "{ENTER}", True
'Selection.NumberFormat = "yyyy-mm-dd"
Next
When I run the code, the data copies into my worksheets but the dates and times are still in a mixed format.
The attempt at forcing the F2+ENTER via the VBA doesn't seemed to have done anything. If done manually it works okay.
Below is an example of data copied from the results in the worksheet
Work Request Code Date Assigned Time Assigned
92926 19/05/2014 14:30.00.00
92927 19/05/2014 15:00.00.00
92928 2014-05-19 15:15.00.00
92934 2014-05-19 14:00.00.00
92527 12/05/2014 07:30
92528 12/05/2014 08:00
92804 2014-05-12 16:15
92805 2014-05-12 16:20.00.00
I use this simple macro to apply F2 + Enter on the currently selected range:
Sub ApplyF2()
Selection.Value = Selection.FormulaR1C1
End Sub
I can think of two options to get Excel to apply the formatting to the cells in one step.
The first is to use the Text to columns functionality even though there is nothing in the column to split.
The second option is to copy a value of 1 and paste it into the cells using the Paste Special - Multiply option.
Although either method should force an update of the cell formating, I would lean towards the first option.
This is incase some of your dates are is stored as text.
Sub Format_Text_to_Columns()
Dim AssDateLastRow As Long
AssDateLastRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd;#"
'Set the format
Range("C4:C" & AssDateLastRow).Select
Selection.TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, _
Space:=True, FieldInfo:=Array(1, 5)
'Use text to columns to force a format update
End Sub
Sub Format_Paste_Special_Multiply()
Dim AssDateLastRow As Long
AssDateLastRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("C4:C" & AssDateLastRow).NumberFormat = "yyyy-mm-dd;#"
'Set the format
Range("C1").FormulaR1C1 = "1"
Range("C1").Copy
Range("C4:C" & AssDateLastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
Application.CutCopyMode = False
Range("C1").ClearContents
'Multiply the dates by 1 to force a format update
End Sub
I struggled to get this to work too. My problem has been not just dates but also data with a single quote in front of it. What I hacked together works great for me. It cleans up over 70,000 cells very fast. Hope it works for you:
(you will change the range and such to suit your needs)
Dim MyRange As Range
Set MyRange = Range(Cells(2, 7), [G1].End(xlDown))
For Each MyRange In MyRange.Cells
'Mimic F2 without SendKeys
MyRange.Value = MyRange.Value
Next
This worked for me.
Dim r As Range
Dim n As Integer
Dim AssDateLastRow As Long
AssDateLastRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
Set r = Range("E2:E" & AssDateLastRow)
r.Select
r.NumberFormat = "ddmmyyyy;#"
r.Select
For n = 1 To r.Rows.Count
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Next n
It is possible to use Text to Columns to solve this problem
1) Highlight the column of data
2) Go to Data -> Text To Columns -> Delimited -> (deselect everything) -> Next
3) On page 3 of the wizard, set the Column Data Format YMD
4) OK
Sub RefreshCells()
Dim r As Range, rr As Range
Set rr = Selection
For Each r In rr
r.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.SendKeys "{F2}"
Application.SendKeys "{ENTER}"
Application.SendKeys "+{ENTER}"
DoEvents
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.SendKeys "{ENTER}"
DoEvents
Next
End Sub
It seems odd that you would need to send keys F2 + Enter. What is the formatting before you run the macro? Try formatting the whole column that way (it won't affect the text).
Columns("C:C").NumberFormat = "yyyy-mm-dd"
My variation
n = Selection.Rows.count
Dim r1 As range, rv As range
Set r1 = Selection.Cells(1, 1)
For I = 1 To n
Set rv = r1.offset(I - 1, 0)
vali = rv.value
IsNumeric(vali) Then
vali = CDbl(vali)
rv.value = 0
rv.value = vali
End If
Try to press F9 or File-Option-formulas-workbook calculation- automatic
I just set the cell to the right of the top entry equal to a formula that multiplied the problem cell times 1. That new cell was a proper number, so then double clicking the handle extended it down the whole column fixed them all!
Sendkeys are not stable. The better way is to store the text in the clipboard and paste it.
See here on how to store values in the clipboard
Sub CopyText(Text As String)
Dim MSForms_DataObject As Object
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub
Sub Test()
CopyText (ActiveCell.Value)
ActiveCell.PasteSpecial
End Sub
'In place of active cell, you may pass a range
This works for me
Sub f2Cells(sel as Range)
Dim rng as Range
On Error GoTo exitHere
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each rng In sel.Cells
If Not Intersect(sel, Application.Range(rng.Address)) Is Nothing And _
Application.Range(rng.Address).EntireColumn.Hidden = False And _
Application.Range(rng.Address).EntireRow.Hidden = False Then
Application.Range(rng.Address).Application.SendKeys "({F2}{ENTER})", True
End If
Next rng
exitHere:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
Application.SendKeys "{NUMLOCK}", True
End Sub
Then from your function you can just call
f2Cells shAss.Range("C4:C" & AssDateLastRow)
I just got it, Simple
Select all the cells you want to hit F2 and Enter and run this short macro:
Sub AutoF2Enter()
Selection.Value = Selection.Value
End Sub
Works on date and numbers!
50.000 cells in a second!
Related
i need a simple vba code. I hope someone can help me.
So, I want to copy the range B2:E6 and leave some cells marked with a special condition. I created a rule in cells A2:A6 with the value Y / X. In the end, I want to paste the value B2:E6 in the range F9:I13 only if the value is Y.
I am attaching the following image to make it easier for you to understand.
Any help will be great. And sorry my english is bad.
Maybe this can get you started
Sub Macro1()
Dest = 8
For Row = 1 To 6
If Cells(Row, 1) <> "x" Then
Range(Cells(Row, 2), Cells(Row, 5)).Select
Selection.Copy
Cells(Dest, 6).Select
ActiveSheet.Paste
End If
Dest = Dest + 1
Next Row
End Sub
I recommend that you first define your working worksheet, if the CommandButton1 button code linked to the CommandButton1_Click() event, showen in your code, is not associated with your working sheet (Sheet9). Otherwise, the code will be executed on another Sheet than Sheet9, on which you want the conditions to be fulfilled.
So, I suggest this code, that formats also the target table "(F8:I13)":
Private Sub CommandButton1_Click()
Dim myWorkingSheet As Worksheet
Dim Working_Range As Range, Target_Range As Range
Dim Line_to_Read As Double, Table_Shift As Double
Set myWorkingSheet = Sheets("Sheet9")
myWorkingSheet.Activate
' Copy the header table
myWorkingSheet.Range("B1:E1").Copy Range("F8")
Application.CutCopyMode = False
' Copy the format of the table
myWorkingSheet.Range("B1:E6").Copy
myWorkingSheet.Range("F8").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
' Copy table if current cell in column A = "y"
Set Working_Range = myWorkingSheet.Range("A2:A6")
Line_to_Read = 2
Table_Shift = 7 'To start at F9 cell
For Each wr In Working_Range
If wr = "y" Then
myWorkingSheet.Range(Cells(Line_to_Read, 2), Cells(Line_to_Read, 5)).Copy myWorkingSheet.Range(Cells(Line_to_Read + Table_Shift, 6), Cells(Line_to_Read + Table_Shift, 10))
End If
Line_to_Read = Line_to_Read + 1
Next
' To point the cursor at the first cell.
myWorkingSheet.Cells(1, 1).Select
End Sub
To avoid the repetition of myWorkingSheet in the you use With clause and End With.
I have a macro-enabled spreadsheet that allows me to hide various columns and rows based on certain criteria I select and trigger on the sheet.
First I select the relevant columns by marking that column with a "Y", and hiding the remaining columns with a "N" with the following routine:
Sub Hidecolumn()
Dim p As Range
For Each p In Range("H1:BN1").Cells
If p.Value = "N" Then
p.EntireColumn.Hidden = True
End If
Next p
End Sub
Please note that Columns("A:G") will always be visible. Only Columns("H:BN") can be hidden based on the above. This works perfectly.
Then, I will hide the the various rows that do not have a value in the remaining visible columns for Columns("H:BN"), which is 59 possible columns. If any column within that row has a value, then that row will remain visible. If there are NO values in any of the visible columns for that row, then I hide that row. It is entirely possible that the 59 columns could reduce to 7. I do this with the following routine:
Sub HideRowsSecond()
Module2.Unhiderow
Dim srcRng As Range, ws As Worksheet
Set ws = ActiveSheet
Set srcRng = ws.Rows("5:" & ws.Cells(ws.Rows.Count, 4).End(xlUp).Row)
Dim R As Range, hideRng As Range
For Each R In srcRng
If Application.CountA(R.Columns("H:BN").SpecialCells(xlCellTypeVisible)) = 0 Then
If hideRng Is Nothing Then
Set hideRng = R.EntireRow
Else
Set hideRng = Application.Union(hideRng, R.EntireRow)
End If
End If
Next R
If Not hideRng Is Nothing Then hideRng.EntireRow.Hidden = True
MsgBox ("Complete")
End Sub
Please note that the starting row is Row("5"), and we use Column("D") as the counting column because it has a value in every cell down to the bottom of the data set. This works perfectly.
Now that I have my desired data set, I need to save this visible data set to a new XLSX file that the user can name themselves and save in the directory of their choice. The target range will begin with cell "C3" and we need to save however many visible columns there are to the right and however many visible rows there are down to the bottom of the data set.
Can someone please help me with this final step?
Here is the solution.
Sub exportToFile()
Dim rng As Range
With ActiveSheet
Set rng = Application.Intersect(.UsedRange, .Cells.Resize(.Rows.Count - 2, .Columns.Count - 2).Offset(2, 2))
End With
rng.Select
rng.SpecialCells(xlCellTypeVisible).copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Range("A" & Row & ":N" & Row).EntireRow.AutoFit
ActiveSheet.Range("A1").Select
Application.Dialogs(xlDialogSaveAs).Show ("c:\")
End Sub
here's the code I currently have in VBA (Excel) at the moment. Most of it has come from macro recordings that I've made. What I'm looking for is to be able to insert for example, row 10 as just 10 in the inputbox without having to put it in as 10:10. Is there a way for me to edit my current code to allow this? I've tried using Rows("TargetRow:TargetRow") but that gives odd results.
Dim TargetRow As Variant
TargetRow = InputBox("Insert row # where data should be inserted. This should take the format XX:XX (e.g. 90:90 for row 90)", "All Industries Row", "XX:XX")
wbThis = ThisWorkbook.Name
Windows(wbThis).Activate
Rows(TargetRow).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromAbove
Windows("otherworksheet.xlsx").Activate
Range("A119:J119").Select
Application.CutCopyMode = False
Selection.Copy
Windows(wbThis).Activate
Range(TargetRow).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Use following sub to select rows using inputbox
Sub SelectRow()
Dim lnRow As Long
lnRow = InputBox("Enter Row number.", "Row Input")
Rows(lnRow & ":" & lnRow).Select
End Sub
If you need a Range from user input, the simplest way is to use the Excel version Application.InputBox with a type of '8' (see the documentation here).
Dim TargetRow As Range
Set TargetRow = Application.InputBox("Select the row where data should be inserted.", _
"All Industries Row", , , , , , 8)
Debug.Print TargetRow.Address
Note that you should probably also get rid of the Select and Activate calls and use your object references directly.
How can I convert numbers stored as text to numbers?
I have tried setting:
ActiveSheet.Range("H154").NumberFormat = "General"
But it doesn't work!
The only things I've found that work are using "Text to columns" or clicking the cell to edit it and then clicking Enter.
But I would really like to find a way to turn number cells in a sheet stored as text into numbers using VBA.
A general technique is to Copy PasteSpecial, Multiply by 1
In code, something like this:
Sub ConvertToNumber()
Dim rng As Range
Dim cl As Range
Dim rConst As Range
' pick an unused cell
Set rConst = Cells(1, 4)
rConst = 1
Set rng = Cells.SpecialCells(xlCellTypeConstants)
rng.NumberFormat = "General"
rConst.Copy
rng.PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply
rConst.Clear
End Sub
Just use CDbl():
ActiveSheet.Range("H154") = CDbl(ActiveSheet.Range("H154"))
I'm not a coding expert and the "Number Stored as Text" error plagued me for a long time.
I finally found this:
Delimited Text-to-Columns in a Macro
Which got me to this:
Sub ConvertTextToNumber()
Sheets("Worksheet_Name").Select
Range("A1").Select
Selection.TextToColumns _
Destination:=Range("A:A"), _
DataType:=xlDelimited
End Sub
I use this in a macro to copy & reorder columns in a new sheet:
Sub ColumnReorder()
'**********************************************************
'Paste this macro into the Workbook of each new "Employee_List_Weekly_Update"
'Functionality:
'1. Column order in the "Employee_List_Weekly_Update" worksheet changes fairly often.
' The macro will find each column by header name,
' select that column and copy it to the new sheet.
'2. The macro also converts "Employee ID#" to a number,
' removing the "Number saved as Text" error.
'**********************************************************
'Create new sheet
Sheets.Add.Name = "Roster_Columns_Reordered"
'Repeat for each column or range
'Find Column in "Employee_List_Weekly_Update" - Copy it - Paste it in "Roster_Columns_Reordered" - Employee ID#
Dim a As Integer
Sheets("Employee_List_Weekly_Update").Select
Set rngData = Range("A1").CurrentRegion
a = Application.WorksheetFunction.Match("Employee ID#", Range("A1:BB1"), 0)
Columns(a).Select
Selection.Copy
Sheets("Roster_Columns_Reordered").Select
Range("A1").Select
ActiveSheet.Paste
'Use TextToColumns to convert "Number Stored as Text "
Selection.TextToColumns _
Destination:=Range("A:A"), _
DataType:=xlDelimited
'Find Column in "Employee_List_Weekly_Update" - Copy it - Paste it in "Roster_Columns_Reordered" - Name
Dim b As Integer
Sheets("Employee_List_Weekly_Update").Select
Set rngData = Range("A1").CurrentRegion
b = Application.WorksheetFunction.Match("Name", Range("A1:BB1"), 0)
Columns(b).Select
Selection.Copy
Sheets("Roster_Columns_Reordered").Select
Range("B1").Select
ActiveSheet.Paste
'Go to "Roster_Columns_Reordered" - Add AutoFilter - Freeze Top Row
Rows("1:1").Select
Selection.AutoFilter
With ActiveWindow
.SplitColumn = 2
.SplitRow = 1
End With
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
End Sub
if you want to convert a selection (even with text in it!), you can use the code by firefiend (http://www.ozgrid.com/forum/showthread.php?t=64027&p=331498#post331498)
I think the magic is in .Value = .Value
vba
Sub macro()
Range("F:F").Select 'specify the range which suits your purpose
With Selection
.NumberFormat = "General"
.Value = .Value
End With
End Sub
I'm quite new to Excel and completely new to this forum.
I have taken the code from the below forum and modified it to my need.
http://pressf1.pcworld.co.nz/showthread.php?90122-Creating-Macro-to-copy-and-paste-data-into-the-next-empty-column.
Sub copyTotals()
Dim TargetSht As Worksheet, SourceSht As Worksheet, SourceRow As Integer, SourceCells As Range
Set SourceSht = ThisWorkbook.Sheets("DUN - Jan")
Set TargetSht = ThisWorkbook.Sheets("DUN Jan - Jan,Feb,Mar,Apr")
Set SourceCells = SourceSht.Range("L36,N36")
If TargetSht.Range("C11").Value = "" Then
SourceRow = 1
ElseIf TargetSht.Range("C41") <> "" Then
MsgBox ("The sheet is full, you need to create a new sheet")
Else
SourceRow = TargetSht.Range("C41").End(xlUp).Row + 1
End If
SourceCells.Copy TargetSht.Cells(SourceRow, 3)
End Sub
The problem is that the values pasted have the formating of the source and i only want to paste the values.
Can someone please help me with this.
Use .Copy together with .PasteSpecial. Instead of:
SourceCells.Copy TargetSht.Cells(2, SourceCol)
Do this:
SourceCells.Copy
TargetSht.Cells(2, SourceCol).PasteSpecial xlPasteValues
Using the macro recorder yields this kind of thing. I use it a lot when stuck.
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
You don't need to copy and paste to do this (at least in Excel 2010 and above, I think). You just set the .Value of the range to equal itself. eg:
rng.Value = rng.Value
or
Sheet1.Range("A1:A10").Value = Sheet1.Range("A1:A10").Value
since .Value "Returns or sets a Variant value that represents the value of the specified range."
Note that this just works for values, not formats.
http://msdn.microsoft.com/en-us/library/office/ff195193(v=office.15).aspx
right click in the cell and select paste special then you can choose values only
edit: for macros its the same principle
use
.PasteSpecial xlPasteValues
like here
Set rng6 = .Range("A3").End(xlDown).Offset(0, 41)
rng6.Copy
ActiveSheet.Paste Destination:=Worksheets("Positions").Range("W2")