I have written a macro to copy and paste several cell values from one worksheet to another. This has been successful on all fields except one containing a date value.
For example when the cell contains '08-Jan-14' the pasted value is an integer '41647'.
How do I ensure the pasted value received by the new worksheet will be in date format?
Sub place_data(Source As Worksheet, Destination As Worksheet, Optional WorkbookName As String,
Optional rowToWrite As Integer)
Dim iSourceHeader As Integer
Dim iCol As Integer
Dim lSourceEnd As Long
Dim lDestEnd As Long
Dim rSource As Range
Dim rDestination As Range
Dim rngFrom As Excel.Range
Dim rngTo As Excel.Range
Set rngFrom = Workbooks(WorkbookName).Sheets(Source.Name).Range("D51")
Set rngTo = ThisWorkbook.Sheets("Self Test Summary").Range("A" & rowToWrite)
rngFrom.Copy
rngTo.PasteSpecial Paste:=xlValues
You are just pasting the values and not the formats. You need to add one more line after pasting
rngFrom.Copy
rngTo.PasteSpecial Paste:=xlValues
rngTo.Numberformat = "DD-MMM-YY"
Another Way
rngTo.Value = rngFrom.Value
rngTo.Numberformat = "DD-MMM-YY"
replace:
rngFrom.Copy
rngTo.PasteSpecial Paste:=xlValues
with:
rngFrom.Copy rngTo
Related
I would need to open a random selected link from a cell to a website in my list. My internet links are put in column B, but I cannot get it to open the hyperlink after it has selected a cell from my list.
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets("Sheet1")
With Sh
Set Rng = .Range("C1:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
End With
For Each Cell In Rng
ThisWorkbook.FollowHyperlink Cell.Value
Next Cell
End Sub
Just to be sure I got it right:
The addresses are stored in column B (in your code you're using column C)
You don't want to open all of the addresses, but only one random one?
The addresses are full URLs? (Like "https://stackoverflow.com/")
I tidied up your code a little bit. Read the comments, to understand what is happening.
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets(1)
' Get a Range object of all possible addresses
Set Rng = Intersect(Sh.UsedRange, Sh.Range("B:B"))
' Open one random element of them
ThisWorkbook.FollowHyperlink Rng(Int(Rnd * Rng.Count) + 1)
End Sub
I'm trying to set a range in VBA as the range of the inputted string that I am looking for. The full procedure is supposed to pop up a dialog box to look for a specific string, find the string, create a range called location, set this range to the range of the string that was found, move a finite amount of columns to the right, and with that new columns value, print a string into that range.
The problem right now is that for some reason It is not setting the range to the range of the string it finds.
There is only one instance of the string throughout the workbook.
I'm also relatively new to VBA so there are something commands I don't know or understand how they work.
Sub test()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim Inp As String
Dim Loc As Range
Dim Row As Integer
Dim Col As Integer
Dim NewLoc As Range
Dim Sh As Worksheet
Inp = InputBox("Scan ESD Tag")
For Each Sh In ThisWorkbook.Worksheets
With Sh.Columns("A")
Set Loc = .Find(What:=Inp)
End With
Next
Row = Loc.Row
Col = Loc.Column + (3 * 5)
Set NewLoc = Worksheets("Building 46").Cells(Row, Col)
NewLoc.Value = "Over Here"
Range("G2") = 6
End Sub
Your problem is probably that your final block should be inside the loop as otherwise Loc is likely to be Nothing (unless the term is found on the last sheet) and your code will error. You should also check first that it is found to avoid such errors.
Sub test()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim Inp As String
Dim Loc As Range
Dim Row As Integer
Dim Col As Integer
Dim NewLoc As Range
Dim Sh As Worksheet
Inp = InputBox("Scan ESD Tag")
For Each Sh In ThisWorkbook.Worksheets
With Sh.Columns("A")
Set Loc = .Find(What:=Inp)
If Not Loc Is Nothing Then
Row = Loc.Row
Col = Loc.Column + (3 * 5)
Set NewLoc = Worksheets("Building 46").Cells(Row, Col)
NewLoc.Value = "Over Here"
Range("G2") = 6 'should specify a sheet here
Exit Sub
End If
End With
Next
End Sub
I am trying to create a macro to auto filter on a named range. I have the following code:
Sub Filter()
Dim vCrit As Variant
Dim wsO As Worksheet
Dim wsL As Worksheet
Dim rngCrit As Range
Dim rngOrders As Range
Set wsO = Worksheets("Historical Holdings")
Set wsL = Worksheets("Control")
Set rngOrders = wsO.Range("$A$1").CurrentRegion
Set rngCrit = wsL.Range("Filter_Range")
vCrit = rngCrit.Value
rngOrders.AutoFilter _
Field:=1, _
Criteria1:=Application.Transpose(vCrit), _
Operator:=xlFilterValues
End Sub
The macro works, but it filters everything out instead on selecting the values in the named range. Does anyone know what I am doing wrong?
I am working in excel. I need to be able to find the first blank/empty cell in row 20 starting from column A. The return should be the actual column namei.e. AB, AAD, etc. What I am going to do is paste a value into this cell. Here is a picture of it with that row highlighted in green.
Dim wkb As Excel.Workbook
Dim wks2 As Excel.Worksheet
Dim strMSG As String
Dim LastRow As Long
Set wkb2 = ThisWorkbook
Set wks2 = wkb2.Sheets("Daily")
columnNumber = wks2.Cells(20, wks2.Columns.Count).End(xlToLeft).Column
Your query of: -
to find the first blank/empty cell in row
Is not answered by your code wks2.Cells(20, wks2.Columns.Count).End(xlToLeft).Column. Its a subtle but significant difference.
.End(xlToLeft) or .End(xlUp) is often used to find the last used cell in a row/column, a common requirement. To find the first used cell you either want to check each one or create a range based on all blank cells in a range, and look at the first item in that range.
The below code did it for me, and included the column reference as a letter.
Public Sub Sample()
Dim wkb2 As Excel.Workbook
Dim wks2 As Excel.Worksheet
Dim strMSG As String
Dim StrColumn As String
Set wkb2 = ThisWorkbook
Set wks2 = wkb2.Worksheets("Daily")
StrColumn = Replace(wks2.Range("20:20").SpecialCells(xlCellTypeBlanks).Cells(1, 1).Address, "$", "")
StrColumn = Left(StrColumn, Len(StrColumn) - 2)
Set wks2 = Nothing
Set wkb2 = Nothing
End Sub
I have a function that converts a column number to its letter, but I will try and convert it to simple code.
dim colLetter as string
Dim vArr
vArr = Split(Cells(1, columnNumber).address(True, False), "$")
colLetter = vArr(0)
I am not sure how well it works standalone. The function that I use is:
Public Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).address(True, False), "$")
Col_Letter = vArr(0)
End Function
And I know that works. Use whichever you like!
Basically I'm creating a excel app that, when run, will prompt the user to point at the a specific excel file, and it will take the location in as a string, that works fine. What I am not sure how to do is choose a range in the active worksheet and take the value in each cell and combine them into 1 string.
This is my code so far:
Option Explicit
Sub locate_file()
Dim file As String
Dim sheet1_95 As String
Dim theRange As Range
'prompt user for location of other excel sheet'
file = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
'test input of location'
Workbooks("testing input file.xlsx").Sheets("location").Activate
Range("A1") = file
'activate the workbook and sheet'
Workbooks("95%.xlsx").Sheets("DT").Activate
'Testing retrieving cells as string'
Set theRange = Range("A2:A4")
'how do i retrieve values in this range and combine them into 1 string?'
End Sub
What I am not sure how to do is choose a range in the active worksheet
By using the Application.InputBox function (as opposed to VBA.InputBox):
dim r as range
set r = application.inputbox("Select a range", Type:=8)
and take the value in each cell and combine them into 1 string.
By looping through the cells:
dim c as range
dim s as string
for each c in r.cells
s = s & c.value
next
'Testing retrieving cells as string'
Set theRange = Range("A2:A4")
'how do i retrieve values in this range and combine them into 1 string?'
Dim c as int, x as int
Dim strValue as string
c = therange.rows.count
strValue = vbnullstring
for x = 1 to c
strValue = strValue & theRange.cells(x,1).value
next x