I am working with a code to have a user enter in a year, to which excel would then find in a row, and then autofill the formula in that column. I have managed to be able to get the input and column aspect down, but am struggling with how to incorporate my sting into a range. Please help!
Code below.
Sub Copy_formula()
NewPageName = InputBox("Enter in Year")
Dim rFind As Range
Sheets("data_calc").Select
With Range("A2:AH2")
Set rFind = .Find(What:=NewPageName, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
MsgBox rFind.Column
End If
End With
Selection.AutoFill Destination:=Range(Cells(3, "rFind"), Cells(2393, "rFind"))
Range(Cells(3, "rFind"), Cells(2393, "rFind")).Select
End Sub
"rFind" within double quotes is a String which VBA will try to convert to a column number within a Cells() statement. As columns run from "A" to "XFD", anything beyond that should cause an error. So loose the double quotes.
However, that won't entirely solve your problem. The default return for a Range object is its .Value property.
What you want is the Range.Column property.
So change your Range(Cells(3, "rFind"), Cells(2393, "rFind")) to:
Range(Cells(3, rFind.Column), Cells(2393, rFind.Column))
Related
So using VBA I'm trying to set the fillable fields in a form to an "allowed edit range"
Most fields on my form are merged so I can loop through get a selection and then select/deselect cells to the exact set I desire. So I get a result that looks like this
However the range definition looks like this $E$24:$G$24,$E$25:$G$25,$E$26:$G$26,$E$27:$G$27,$J$24:$L$24,$J$25:$L$25,$J$26:$L$26,$J$27:$L$27,$O$24:$Q$24,$O$25:$Q$25,$O$26:$Q$26,$O$27:$Q$27
As I have many more fields on this form this becomes an issue as the "allowed edit range" is only able to go up to 254 chars.
What I would like is a shorter range definition like this
E24:G27,J24:L27,O24:Q27
Then I can add that to an "allowed edit range"
Currently I'm iterating through each cell in the form and unioning any cell that is merged
Sub SelectMergedCells()
Dim scan_range As Range
Dim cell As Range
Dim merge_range As Range
Set scan_range = ActiveSheet.Range("B11:AM69")
For Each cell In scan_range
If cell.MergeCells Then
If merge_range Is Nothing Then
Set merge_range = cell
Else
Set merge_range = Union(merge_range, cell)
End If
End If
Next cell
merge_range.Select
End Sub
Is there a better way to select the cells? Is there a way to reduce my selection definition to something shorter? Or do I have to break up my definition into multiple 254 char chunks and add multiple ranges?
TIA
If I understand you correctly and if you don't mind using selection ... this is to answer this quote :
What I would like is a shorter range definition like this
so maybe you want to see the code below to help you get started....
The merge cells in a sheet is like this (please ignore the fill color as they are used to be easier to see the merge range).
Expected result :
F3:H3,H5:J6,F7:G7,A7:C8,I8:J11,E9:G11,A2:C4,F2:G2
So after I macro-recording my manual process then modified it a bit, the code is something like this :
Sub test()
Dim rg As Range: Dim c As Range: Dim rgU As Range
Application.ScreenUpdating = False
Set rg = Range("A1:J12"): rg(1, 1).Activate
'Set rg = Range("A1:N6"): rg(1, 1).Activate
With Application.FindFormat
.WrapText = False
.ShrinkToFit = False
.MergeCells = True
End With
Set c = rg.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True)
If Not c Is Nothing Then
fa = c.Address
Do
c.Select
If rgU Is Nothing Then _
Set rgU = Selection _
Else Set rgU = Union(rgU, Selection)
Set c = rg.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True)
Loop While c.Address <> fa
End If
Debug.Print Replace(rgU.Address, "$", "")
Application.FindFormat.Clear
End Sub
Debug print result is the same with the expected result:
F3:H3,H5:J6,F7:G7,A7:C8,I8:J11,E9:G11,A2:C4,F2:G2
Basically the sub is looping to a cell which is merged as c variable.
select the c, and create rgU variable as the union of rgU and the selection (not the c).
Test with a merge cell similar in your case :
the debug print result is like this :
A2:C5,F2:H5,K2:M5
As I have many more fields on this form this becomes an issue as the
"allowed edit range" is only able to go up to 254 chars.
just now I test the code which rg is A1:AQ75 (multiplying the existing merge cell). Although the rgU.select show a correct result, but I'm sorry, the debug.print rgU.address is only until cell R17.
So, even after this $E$24:$G$24,$E$25:$G$25,$E$26:$G$26,$E$27:$G$27 string is already shorten like this E24:G27, my code is still useless as I think it still won't be able to show the address until the last column and row of the merge cell if the range of the merge cells is too big (cell AQ75 in my case, cell AM69 in your case).
So it need a loop within rgU to get all the merge cell address :
for each cell in rgU.areas:debug.print cell.address:next
Then the last looped result is $AO$97:$AQ$75
btw, about allowed edit range, can't you just use your merge_range variable as reference without the need to have it's address?
I am trying to set values for variables to be used later on in my code based on the column value of a found cell.
Thanks to some existing subject, I was able to find the cell, but I am unable to set its column value to a name.
Here is my code:
Dim rFind As Range
With Range("A1:DD1")
Set rFind = .Find(What:="FIND", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
MsgBox rFind.Column
End With
End Sub
The MsgBox returns the correct column number but my attempts at getting it set to a name has failed.
Thanks for your help !
EDIT:
My goal is to create an automatic table with data extracted from another table. I want to use the column number to extract data for each row of my table from the correct column. I currently use a system where I "hardcode" my names for the current column number (e.g.: Publi Const example As Integer = 5). However this is not a flexible solution if my data table were to change (new or removed columns). Finding the column to then set it would solve the issue.
Perhaps this, to name the whole column?
rFind.EntireColumn.Name = "Fred"
Fuller code
Sub x()
Dim rFind As Range
With Range("A1:DD1")
Set rFind = .Find(What:="FIND", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
rFind.EntireColumn.Name = "Fred"
Else
msgbox "Not found"
End If
End With
End Sub
I use the following formula to get the last non-zero value in a column:
ActiveSheet.Range("A5").Formula = "= LOOKUP(2,1/(H:H>1),H:H)"
It works nicely. But I would like to get the address of that cell. I have tried several lines of code found here and there and most boil down to something like this:
`Dim rb as Range
rb ="LOOKUP(2,1/(H:H>1),H:H)"
MsgBox(rb.Address)
MsgBox(rb.Row)
MsgBox(rb.Column)`
It goes without saying that it does not work. How can one find the address of the cell that LOOKUP returns? Thank you very much in advance.
If you want to stick with VBA, and use your original concept, you can use your current Formula, and afterwards use Find function to look from the end to find the row.
Code
Option Explicit
Sub GetAddressofLookup()
Dim FindRng As Range
ActiveSheet.Range("A5").Formula = "= LOOKUP(2,1/(H:H>1),H:H)"
Set FindRng = ActiveSheet.Columns("H").Find(what:=ActiveSheet.Range("A5").Value, Lookat:=xlPart, LookIn:=xlFormulas, _
searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False)
MsgBox FindRng.Address
End Sub
This worksheet formula will give the address of the last value in column H that is greater than zero:
="H"&LOOKUP(2,1/(H:H>0),ROW(H:H))
In VBA:
Sub dural()
MsgBox "H" & Evaluate("LOOKUP(2,1/(H:H>0),ROW(H:H))")
End Sub
Good Morning,
I am working with a rather large dataset and I am attempting to Find/Replace values which have been modified in one spreadsheet back into the original. What I would like to do is have the macro look for the information in Cell A1 and Replace it with the value in Cell B1, and then continue down until Cell A3600:B3600. Generally, I'm pretty good at peicemealing the code I find on here to get it to do what I want, but I'm at a loss as to what I should be looking for.
What I have right now is:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1").Select
Selection.Copy
Cells.Replace What:=ActiveCell.Value, Replacement:="????", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
From here I am at a loss. I understand Range("A1").Select will paste into the Find section of the Find/Replace box, but how do I tell excel I want to select another Cell, in this case B1, for the replace portion? And then how do I tell Excel I want it to keep doing this until it runs out of values in the A Column?
Thank you in advance for any assistance you can provide.
I think you are after something like the code below:
Option Explicit
Sub Macro1()
Dim Rng As Range
Dim OrigStr As String, ReplaceStr As String
Set Rng = Range("A1:B3600")
OrigStr = Range("A1").Value2
ReplaceStr = Range("B1").Value2
' option 1: replace only if the whole cell's string equals to OrigStr
Rng.Replace What:=OrigStr, Replacement:=ReplaceStr, LookAt:=xlWhole
' option 2: replace also partial match inside the cell's string
Rng.Replace What:=OrigStr, Replacement:=ReplaceStr, LookAt:=xlPart
End Sub
I am trying to find if a certain date is in a range of dates.
This is the range of dates:
01/01/2013
11/02/2013
29/03/2013
20/05/2013
01/07/2013
05/08/2013
02/09/2013
14/10/2013
11/11/2013
25/12/2013
26/12/2013
Here is the VBA code:
' Format Holiday Rows '
With ConfigData.Range("B8:B18")
Set holidays = .Find(s1.Cells(row_count, 1))
If Not holidays Is Nothing Then
MsgBox s1.Cells(row_count, 1)
End If
End With
In the above code, the first MsgBox that pops up reads "11/01/2013". This makes absolutely no sense, as that value is not in the range.
Note: ConfigData.Range("B8:B18") refers to the range of dates shown above.
ALSO: This code is within a for loop that increments the value of s1.Cells(row_count, 1). Starting at 01/01/2013 until 31/12/2013
If you just want to confirm a calendar day in your series is within the holiday list, then you could even use vlookup:
Dim strFound As String
On Error Resume Next
strFound = Application.Vlookup(s1.Cells(row_count, 1), .Range("B8:B18"), 1, 0)
If IsError(strFound) Then
MsgBox "Not Found"
Else
'-- Found
End If
On Error GoTo 0
The following code works for me:
Sub thing()
Dim cell As Range, _
holidays As Range
For Each cell In Range("D1:D365")
With Range("A1:A11")
Set holidays = .Find(cell.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not holidays Is Nothing Then
Debug.Print cell.Value
End If
End With
Next cell
End Sub
If this doesn't work, I'd suggest it's likely you have a cell formatting issue. Select one of your date cells. Go to the immediate window (Alt+F11, then Ctrl+G from Excel), type ? Selection.Value2 and press enter. Does that return a numeric value (~41000)?
Alternatively, you could reenter the dates in a completely new sheet (enter the first couple manually and drag down, do not copy and paste as formatting will be copied also) and try again. This should at least remove odd formatting as a potential issue.
It is important to note that excel uses american date formatting. ie mm/dd/yyyy and it can therefore be a little tricky to get the .Find() function to work properly. Make sure your variables are formated properly in order for excel to hopefully give you what you're looking for:
Dim strdate As String
Dim aCell As Range
strdate = ActiveSheet.Cells(1,1)
strdate = Format(strdate, "Short Date")
On Error Resume Next
Set aCell = Cells.Find(What:=CDate(strdate), After:=Range("A1"), LookIn:=xlFormulas , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If rCell Is Nothing Then
MsgBox("Date cannot be found. Try Again")
End If
End Sub
Of course there are a lot of annoying things that can happen with the date formatting, but this is assuming the dates you're looking for ar in the "Short Date" format.
'To find a cell elsewhere in a worksheet with the same specific date as a reference cell:
'First copy all dates to cells immediately to their left.
'Format the copied cells as "General"
'Run this code - then use the dateRow and DateCol variables (eg in vlookup)
'Works in Excel 2013 (The "General" column must not be hidden - Hide by formatting in background colour)
Dim dateVal
Dim DateRow
Dim DateCol
dateVal = Range("j8").Value 'must be in general format
Cells.Find(What:=dateVal, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
DateRow = ActiveCell.Row
DateCol = ActiveCell.Column
MsgBox (DateRow & " " & DateCol)
End Sub