I want to check if a content of a range of cells is formated as a date, and if it is, to change the current date type to date type mm.dd.yyyy. To do this I use the code below but it does not seem to work as it is changing the content of all cells in the range - not only to the one formatted as date.
Option Explicit
Public Sub FormatCurrency()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Sheets(1)
Dim Cell As Range
For Each Cell In Sh.Range("R1:W300").Cells
If Cell.NumberFormat = "Date" Then
Cell.NumberFormat = "dd.mm.yyyy"
End If
Next Cell
End Sub
Related
Im setting the location I want to paste at with column_find. I want to paste a range (user_data) at that cell. The macro runs but only pastes 1 value from the range. What am I doing wrong?
Sub Column_Locate()
Dim current_month As Variant
Dim column_find As Range
Dim user_data As Range
current_month = Worksheets("Inputs").Cells(4, 4).Value
Set column_find = Worksheets("Feeder").Range("E2:CZ2").Find(current_month, LookIn:=xlValues, LookAt:=xlWhole).Offset(8, -1)
Debug.Print column_find.Address(0, 0)
Set user_data = Worksheets("Unique Users Data").Range("B2:C3")
Worksheets("Feeder").Select
column_find = user_data
End Sub
you have to adjust the size of "target" range (i.e. column_find) accordingly to the "source" one (i.e. user_data)
also avoid use of Select/Selection/Activate/ActiveXXX pattern , which is both time consuming and prone to have you quickly lose control over your ranges reference and adopt a fully qualified range reference pattern (for instance with the use of With... End With construct)
so you would code (explanations in comments):
Option Explicit
Sub Column_Locate()
Dim current_month As Variant
Dim column_find As Range
Dim user_data As Range
current_month = Worksheets("Inputs").Cells(4, 4).Value
Set user_data = Worksheets("Unique Users Data").Range("B2:C3")
With Worksheets("Feeder") 'reference "Feeder" worksheet
Set column_find = .Range("E2:CZ2").Find(current_month, LookIn:=xlValues, LookAt:=xlWhole).Offset(8, -1) 'search referenced sheet range "E2:CZ2" for 'current_month' value
If Not column_find Is Nothing Then 'if the searched value has been found
With user_data 'reference "source" range
Debug.Print column_find.Address(0, 0)
column_find.Resize(.Rows.Count, .Columns.Count).Value = user_data.Value ' reference a "target" range as the one with found value but with same size as "source" range and write values
End With
End If
End With
End Sub
I am trying to reset the formatting of my excel sheet, the problem is that I have 4 columns which should be date format. How can I find all columns which contain "DATE" in header (Such as : last machined date, assembly date, order date etc..) and change this format to date? Note: Needs to be dynamically because it might change from C:C to E:E in the future or more columns added.
Sub formatTable(ws As Worksheet)
On Error Resume Next
Dim lo As ListObject
Set lo = ws.ListObjects("FilterParts")
'Format the table
ws.UsedRange.Font.Bold = False
ws.UsedRange.Style = "Normal"
lo.TableStyle = "TableStyleMedium9"
'Format every column that has "DATE" in its header to a date column
'ws.Range("C:C").NumberFormat = "dd/mm/yyyy" and so on
End Sub
Just iterate through your columns like this, check if their names contain "Date" and if yes, then format them:
Set lo = ws.ListObjects("FilterParts")
For Each dataColumn In lo.ListColumns
If InStr(dataColumn.Name, "Date") > 0 Then
dataColumn.DataBodyRange.NumberFormat = "dd/mm/yyyy"
End If
Next dataColumn
Run this macro every time you add a new column.
A longer coding option but uses Find to avoid looping through the range.
Dim ws As Worksheet
Dim lo As ListObject
Dim rng1 As Range
Dim StrAddress As String
Set ws = ActiveSheet
Set lo = ws.ListObjects("FilterParts")
Set rng1 = lo.Range.Rows(1).Find("Date", , , xlPart)
If Not rng1 Is Nothing Then
StrAddress = rng1.Address
rng1.Offset(1, 0).Resize(lo.ListRows.Count, 1).NumberFormat = "dd/mm/yyyy"
Do
Set rng1 = lo.Range.Rows(1).Find("Date", rng1, , xlPart)
rng1.Offset(1, 0).Resize(lo.ListRows.Count, 1).NumberFormat = "dd/mm/yyyy"
Loop While StrAddress <> rng1.Address
End If
Dim HdrRow as range
Dim Cl as Range
Set HdrRow = ActiveSheet.UsedRange
Set HdrRow = HdrRow.Row(1) 'assuming row 1 of the data contains headers
For Each Cl In HdrRow.cells
If Instr(lCase(Cl.Value), "date") > 0 then 'This column has "date" in the header text
enter code here
Next Cl
from here you can either store the cell/column number for a loop later or loop the cells in this column right away....
this should get you started just post back if you need more help.
Try:
Range("A1","A50000").NumberFormat = "dd\/mm\/yyyy"
I have several sheets with data, all starting with "input" in the sheetname and all having a date column in column A. I want to create a userform that allows the user to insert a date in a textbox. This date will refer to the date column in the specified sheets. When the user has clicked "Okay", the macro should delete all rows in the sheets from Now() till the specified date. In other words it starts from the bottom and deletes upwards. The rows are not initially sorted according to date. This is what I have so far:
Sub Rens_date()
Dim lRow As Long
Dim lcol
Dim iCntr As Long
Dim wb As Workbook
Set wb = ThisWorkbook.Worksheets
With wb
lRow = wb.Range("A" & Rows.Count).End(xlUp).Row
lcol = wb.Range("A" & Columns.Count).End(xlUp).Column
Set deleterange = .Range(Rens_inputbox.Value, .Cells(lRow, lcol))
End With
For Each Row In deleterange
If wb.Range("A").Cells = Me.Rens_inputbox.Value Then _
deleterange.Delete
End If
Next
End Sub
Code is not working :/
Place this code on your Okay button and this should work. It will iterate over the entire first column of all sheets which has a name that starts with "input_" looking for date between the current date and the date you typed in the textbox.
Private Sub CommandButton1_Click()
Dim actCell As Range
Dim lastDate As Date
Dim startDate As Date
Dim currentCellDate As Date
Dim ws As Worksheet
lastDate = CDate(TextBox1.Value)
startDate = Date
For Each ws In ActiveWorkbook.Worksheets
If LCase(ws.Name) Like "input_*" Then
For Each actCell In ws.ListObjects(1).DataBodyRange.Columns(1).Cells
currentCellDate = CDate(actCell.Value)
If currentCellDate > startDate And currentCellDate < lastDate Then
actCell.EntireRow.Delete
End If
Next
End If
Next
End Sub
I would like to create a function that copies certain excel ranges in worksheets and paste these ranges into a "motherfile".
Now, I am trying with this code:
Sub ranges()
Dim month As Variant
Dim months As Variant
months = Array("V01 DEN HAAG", "V02 AMSTERDAM")
Dim destinationRange As Excel.range
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
For Each month In months
Dim sourceRange As Excel.range
Set sourceRange = Sheets(month).range("H7", range("H7").End(xlToRight))
Call sourceRange.Copy
Call destinationRange.PasteSpecial
Next month
End Sub
But, I get an Application-defined or object-defined error. Any thoughts on what goes wrong? Thanks!
Adding to mielk's anwser the problem is in the codeline:
Set sourceRange = Sheets(month).range("H7", range("H7").End(xlToRight))
This is because if you are collecting from multiple sheets data and you use range("H7").End(xlToRight it will search for this on the active sheet. Therefor it can only find the correct range if its on the correct sheet.
by using the following code:
Set sourceRange = Sheets(month).Range("H7", Sheets(month).Range("H7").End(xlToRight))
it will work no matter which sheet is active at that moment.
another addition is you can copy and paste in 1 code line:
sourceRange.Copy Destination:=destinationRange
see below the entire code:
Sub ranges()
Dim month As Variant
Dim months As Variant
months = Array("V01 DEN HAAG", "V02 AMSTERDAM")
For Each month In months
Dim sourceRange As Excel.Range
Dim destinationRange As Excel.Range
With Sheets("DATASET")
Set destinationRange = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Set sourceRange = Sheets(month).Range("H7", Sheets(month).Range("H7").End(xlToRight))
sourceRange.Copy Destination:=destinationRange
Next month
End Sub
The possibly reason for this error is that you don't have any values in worksheet "DATASET", column B, below 3. row.
Look at this line of code:
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
First it takes the range from cell B3 to the last cell in this column (B1048576 in Excel 2007+).
After that it tries to offset this range by one row down (so it tries to create a range having the same number of rows and columns but starting one cell below).
However, it is not possible, because such range would have to start in cell B4 and end in cell B1048577 and Excel has only 1048576 rows.
If you want to assign the first empty row to the variable destinationRange you should replace this code:
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
with the below:
With Sheets("DATASET")
Set destinationRange = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Both those statements are similar. The difference is that the second one
starts from the last cell in the column B and look for the first non-empty
cell above.
I think this can only be done in VBA. I tried VLOOKUP, but no luck.
I want to search a whole sheet for certain values. These values come from a row in another sheet. Once each value is found, it looks to the top most row and pulls that value.
I might need to loop through each value in the row and search the sheet from there?
my thought/example:
Sheet1!A:A
1234
5325
6346
6342
look in sheet 2 for 1234. lets say its found in cell G5, it will then look at the value in G1 and input that into cell A1 on sheet 2. I'm sorry for making this really confusing.
Here's what I have starting out:
Sub FindValues()
Dim SearchRow As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet
' Set Search value
SearchRow = Sheets("sheet2").Range("B:B")
getting error on the last line. run-time error '13': type mismatch
You need to Set a Range object. You cannot assign it to a string unless you are looking for a property that is a string like the Address property.
Dim SearchRow As String
Dim SearchRange As Range
SearchRow = Sheets("sheet2").Range("B:B").address
Set SearchRange = Sheets("sheet2").Range("B:B")
Please consider the following code for your requirements:
Sub FindValues()
Dim SearchRow As Range
Dim SearchRange As Range
Dim Cell As Range
Dim FirstFound As Range
' Set Search value
Set SearchRow = Sheets("Sheet1").Range("B:B")
Set SearchRange = Sheets("Sheet2").Range("A:K")
For Each Cell In SearchRow
Set FirstFound = SearchRange.Find(Cell.Value2)
If Not FirstFound Is Nothing Then
Cell.Offset(0, 1).Value2 = SearchRange.Cells(1, FirstFound.Column).Value2
Else
Cell.Offset(0, 1).Value2 = "No Value Found"
End If
Next
End Sub
Note that as per your description I assumed that the SearchRange was more than just 1 column.
Basically the script loops through each Cell in the SearchRow and looks for the value in the SearchRange. If it finds the value and returns a subrange representing cells with the search value and sets the value to the right of each Cell to the value of the top cell of the column where the value was found. Hope this serves your needs. Cheers.