I'm trying to write some VBA that can create a named range if it matches a header. I've managed to achieve this but hit a snag that I can't seem to get to work.
I need the named range to be mixed reference only locking in the column. I've got this to work also but when trying to combine everything it doesn't carry the mixed ref.
Examples -
Sub test()
i = 1
Do Until Cells(1, i) = "Created Date"
i = i + 1
Loop
NR1 = Cells(1, i).Offset(1, 0).Address(False, True)
ActiveWorkbook.Names.Add Name:="Created_Date", RefersTo:=NR1
ActiveWorkbook.Names("Created_Date").Comment = ""
End Sub
The above will set the named range with the required mixed ref but obviously no sheet name -
so my thought was simply use activesheet.range(NR1) like so -
Sub test()
i = 1
Do Until Cells(1, i) = "Created Date"
i = i + 1
Loop
NR1 = Cells(1, i).Offset(1, 0).Address(False, True)
ActiveWorkbook.Names.Add Name:="Created_Date", RefersTo:=ActiveSheet.Range(NR1)
ActiveWorkbook.Names("Created_Date").Comment = ""
End Sub
This does create the named range on the sheet but the references go back to being locked to one cell!
any ideas?
You can use the External argument in the Range.Address property to make the Workbook and Sheet name part of the returned address.
If you put an address into the RefersTo argument, it just takes the string as its value instead of going to the cells or range that the address is pointing at. To fix this interaction, you can add an = in front of the address to make the String into a formula which Excel will evaluate.
So with the following changes, your code should do what you want:
NR1 = Cells(1, i).Offset(1, 0).Address(False, True, External:=True)
ActiveWorkbook.Names.Add Name:="Created_Date", RefersTo:="=" & NR1
Related
I am very new to Excel, VBA, Macro. My macro was working fine because I gave a simple formula, for example, D2(column name)-C2(column name) = Total time in HH:MM format new column. But I notice for some output is just #### not sure what is wrong. 1).Column)).Formula = _
"=" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(2, col1).Address(0, 0)
cl.Offset(, 1).EntireColumn.NumberFormat = "[hh]:mm"
The issue occurs because your date in J is earier than in I and therefore the result is negative. You can use the ABS() function to get the absolute difference as positive value.
Therefore adjust your formula as below:
.Formula = "=ABS(" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(2, col1).Address(0, 0) & ")"
You have an incorrect formula in this line:
.Range(cl.Offset(1, 1), .Cells(lastR, cl.Offset(1, 1).Column)).Formula = _
"=" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(**2**, col1).Address(0, 0)
Why .Cells(2, col1)? This is always giving you row2 of column 1.
Also, after this line:
If cl.Value = "Full Out Gate at Inland or Interim Point (Destination)_recvd"
Then
Add:
If cl.Offset(0,1).Value = "Response Time" Then Exit For
This will keep you from inserting a new column every time you run the macro.
Try using clear variable names and consistent method for referring to rows and columns.
actCol = col1
recvdCol = cl.Column
responseCol = cl.offset(0,1).Column
.Range(lastR, responseCol).Formula = _
"= Abs(" & .Cells(lastR, recvdCol) & "-" & .Cells(lastR, actCol).Address(0, 0) & ")"
I would use a simpler approach. Highlight the entire table, and click "Format as Table", and be sure to check off "My table has headers." This will give you a named range (default name is Table1, but you can change it). Then, in the Response Time column, simply enter your formula on the first row of the table, but use your mouse to select the cells instead of typing in a cell name like "I2". You will find that the resulting formula includes something like =[#actl]-[#recvd], except that the actl and recvd will be replaced by your actual column names. And, the formula will apply to every row of the table. If you add a new row, the formula will automatically appear in that row. No code needed.
If you have a reason to use code instead of a Table (named ranges), then I would recommend (1) this code be placed directly in the "Main" worksheet module and (2) use use the "Worksheet_Changed" procedure. Microsoft Excel VBA Reference. In this case, any time the
Private Sub Worksheet_Change(ByVal Target As Range)
'Note, Target is the Range of the cell(s) that just changed.
If Intersect(Target, Range("A1:A10")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Cells(1, Target.Column) = "Full Out Gate at Inland or Interim Point (Destination)_actual" Then
' Cell in actual column was modified. Let's set the formula in the Response Time column:
On Error Goto EH
Application.EnableEvents = False
' Add your code here. You'll need to modify it somewhat to accommodate this methodology.
Application.EnableEvents = True
End If
EH:
Application.EnableEvents = True
Err.Raise ' expand this to whatever error you wish to raise
End Sub
Err.Raise help
I'm working on problem that necessitates the use of nested formulas in excel. For eg:
I have a column for errors and one for its analysis
Error Analysis
Enter a valid material number Invalid Material
Eg errors:
Enter a valid material number; The material number 1234 does not
exist.
PO number XYZ does not exist.
VIN number 123 does not exist.
Country of origin AB does not exist.
I have a compendium of such errors and their analyis in the next sheet, and I'm using VLOOKUP in conjuction with FIND to lookup the analysis for the known errors.
=VLOOKUP(LEFT(F2, FIND(" ", F2, FIND(" ", F2) + 1) - 1)&"*", 'Sheet2'!A:B, 2, 0)
What i'm trying to do here is extract the first two words from the error and append a * to it and use it in VLOOKUP.
It would be something like Vlookup "PO number *" in the other sheet and get the analysis for it. Asterisk is because I don 't get the same number daily. And I also know that the extracted first two words of the error will be unique. (I know that error with "Enter a" as the first two words will not appear again).
Now I get errors in the same column so I thought of making a button and writing a code which uses the above formula.
I tried to modify some code off the net, but I'm not getting anywhere with it. I'm totally new to VBA. It'd be great if you can provide a snippet for this. I'll try to replicate the procedure for other needs.
This code seems to be working for now
Sub PopulateAnalysis()
Dim an_row As Long
Dim an_clm As Long
Dim lft As String
Dim st_num As Integer
Dim fin As String
Dim searchStr As String
Dim soughtStr As String
Table1 = Sheet1.Range("F2:F6") 'ErrorColumn from Error table (How do I make the range dynamic??)
Table2 = Sheet5.Range("A1:B6")
an_row = Sheet1.Range("G2").Row ' Populate this column from the analysis table on sheet2
an_clm = Sheet1.Range("G2").Column
For Each cl In Table1
'How do I translate the above formula into VBA statements??
st_num = InStr(InStr(cl, " ") + 1, cl, " ")
lft = left(cl, st_num - 1)
fin = lft & "*"
Sheet1.Cells(an_row, an_clm) = Application.WorksheetFunction.VLookup(fin, Table2, 2, True)
an_row = an_row + 1
Next cl
MsgBox "Done"
End Sub
This should work. You don't need the debug lines of course ;)
Sub PopulateAnalysis()
Dim rngTableWithErrors As Range
Dim rngTableWithAnalysis As Range
Application.ScreenUpdating = False
'set the range for Table with error, Table1 on sheet 1
With Sheets(1) 'change to name of the sheet, more reliable than index num.
Set rngTableWithErrors = .Range("F2:F" & .Cells(.Rows.Count, 6).End(xlUp).Row)
Debug.Print rngTableWithErrors.Address
End With
'set the range for Table with Analysis, Table 2 on sheet 2
With Sheets(2) 'change to name of the sheet, more reliable than index num.
Set rngTableWithAnalysis = .Range("A1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
Debug.Print rngTableWithAnalysis.Address
End With
'formula for cell G2
'=VLOOKUP(LEFT(F2;FIND(" ";F2;FIND(" ";F2)+1)- 1)&"*";Sheet2!A1:B23;2; 0)
rngTableWithErrors.Offset(0, 1).FormulaR1C1 = _
"=VLOOKUP(LEFT(R[0]C[-1],FIND("" "",R[0]C[-1],FIND("" "",R[0]C[-1])+1)-1)& ""*"",Sheet2!R1C1:R" & rngTableWithAnalysis.Rows.Count & "C2,2, 0)"
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Notes
You can notice, that we are setting the upper left cells of ranges manually. It's better practice to somehow find the upper left cells (using Find method is my favorite) and work from there. You never know, how the user will change the worksheet - i.e. add new rows, columns etc.
I am working with a sheet with almost 200 named ranges (each column is a NR). I now would like to make them dynamic i.e. instead of defining them like
PersonID = =RawData!$A$2:$A$100
I want to do it this way
PersonID = OFFSET(RawData!$A$2,0,0,COUNTA(RawData!$A:$A),1)
But I do not want to do this manually! Is there a way to do this in a texteditor outside Excel or is there a way to do this programatically? I already have the 200 NRs done in the first way in place, but the thought of manually go through them all to change is scaring me.
You can do it in VBA. Example to create a new name:
ActiveWorkbook.Names.Add Name:="PersonID", _
RefersTo:="=OFFSET(RawData!$A$2,0,0,COUNTA(RawData!$A:$A),1)"
To edit an already existing name:
ActiveWorkbook.Names("PersonID").RefersTo = _
"=OFFSET(RawData!$A$2,0,1,COUNTA(RawData!$A:$A),1)"
You indicate in a comment that you would also like to iterate through all named ranges to facilitate changing their definition. To loop through all names you can do this:
Dim nm As Name
For Each nm In ActiveWorkbook.Names
Debug.Print nm.Name
Next nm
or this:
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
Debug.Print ActiveWorkbook.Names.Item(i).Name
Next i
This seems to be a pretty good tool to have in your toolbox?
Sub MakeRangesDynamic()
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
If Not (ActiveWorkbook.Names.Item(i).Name = "NameToExclude1" Xor _
ActiveWorkbook.Names.Item(i).Name = "NameToExclude2" Xor _
ActiveWorkbook.Names.Item(i).Name = "NameToExclude3") Then
FindTheColumn = Mid$(ActiveWorkbook.Names.Item(i).RefersTo, 11, 2)
If Mid$(FindTheColumn, 2, 1) = "$" Then
FindTheColumn = Mid$(FindTheColumn, 1, 1)
Else
FindTheColumn = Mid$(FindTheColumn, 1, 2)
End If
DynNameString = "=OFFSET(RawData!$" & FindTheColumn & "$2,0,0,COUNTA(RawData!$" & FindTheColumn & ":$" & FindTheColumn & "),1)"
Debug.Print DynNameString
'ActiveWorkbook.Names.Item(i).Name.RefersTo = DynNameString
End If
Next i
End Sub
A special thanks goes to Jean-Francois for helping me out.
Change the RawData to your sheetname and the NameToExclude to your ranges to leave untouched.
Remove the last comment for making it happen! But be sure to make a backup copy first!!!!
I have a problem. I spent hours designing a form which works just great with all your feedback. Today, everything went wrong. The reason for this is simple. A few new columns got added and, obviously, the data my form is reading in is now wrong.
Thus I was thinking of trying the following...
Rather than using the column number as below
TK = Cells(ActiveCell.Row, "S").Value 'everything in the form refers to the active row
I could possibly use the column headings in Row 1.
Is that possible ? This way the spreadsheet can have columns added up to as many as a user would like and the form would dynamically scan for the right heading and get the column number that way.
My thought is, on opening the form, read in all the headings, pick out the ones I need and assign them to a variable. Then I use my normal code and substitute the variable into the column section.
It sounds easy, but I have no idea how to do this.
Use the versatile Find to give you a quick method of detecting where your header is - or if it is missing
Find details here
In the code below I have specified that the search must return
an exact match (xlWhole)
a case sensitive match (False)
The match can be a partial match (xlPart) if you were looking to match say Game out of Game X
code
Const strFind = "Game"
Sub GetEm()
Dim rng1 As Range
Set rng1 = ActiveSheet.Rows(1).Find(strFind, , xlValues, xlWhole, , , False)
If Not rng1 Is Nothing Then
MsgBox "Your column is " & rng1.Column
Else
MsgBox strFind & " not found", vbCritical
End If
End Sub
Why use a loop? There's no need to.
Dim col as variant
Col = application.match("my header", rows(1), 0)
If iserror(col) then
'not found
Else
TK = cells(activecell.row, col)
End if
For this purpose I usually use a function which runs through the headers (in the first row of a sheet) and returns the number of the column which contains the value I have searched for.
Public Function FindColumn(HeaderName As String, Sht As String) As Long
Dim ColFound As Boolean
Dim StartingPoint As Range
ColFound = False
Set StartingPoint = Sheets(Sht).Range("A1")
Do While StartingPoint.Value <> ""
If UCase(Trim(StartingPoint.Value)) = UCase(Trim(HeaderName)) Then
FindColumn = StartingPoint.Column
ColFound = True
Exit Do
Else
Set StartingPoint = StartingPoint.Offset(0, 1)
End If
Loop
If Not ColFound Then FindColumn = 0
End Function
Example:
If the first row of your sheet named "Timeline" contains headers like e.g. "Date" (A1), "Time" (B1), "Value" (C1) then calling FindColumn("Time", "Timeline") returns 2, since "Time" is the second column in sheet "Timeline"
Hope this may help you a little.
Your thought is a good one. Reading in column headers to calculate addresses is one way to avoid hard coding - e.g.
Sub Test()
Dim R As Range
Set R = ActiveSheet.[A1]
Debug.Print ColNo(R, "Col1Hdr")
End Sub
Function ColNo(HdrRange As Range, ColName As String) As Integer
' 1st column with empty header is returned if string not found
ColNo = 1
Do While HdrRange(1, ColNo) <> ""
If HdrRange(1, ColNo) = ColName Then Exit Do
ColNo = ColNo + 1
Loop
End Function
Another way I frequently use - and I must admit I prefer it over the above, is to define Enum's for all my tables in a seperate "definition" module, e.g.
Public Enum T_VPN ' sheet VPN
NofHRows = 3 ' number of header rows
NofCols = 35 ' number of columns
MaxData = 203 ' last row validated
GroupNo = 1
CtyCode = 2
Country = 3
MRegion = 4
PRegion = 5
City = 6
SiteType = 7
' ....
End Enum
and use it like
Sub Test1()
Debug.Print ActiveSheet(T_VPN.NofHRows, T_VPN.Country)
End Sub
As you can see, the usage is simpler. Allthough this is again "some kind" of hardcoding, having all definition in one place reduces maintenance significantly.
I want to update the contents of a cell in a workbook. My code looks a little like this:
ProductionWorkBook.Sheets("Production Schedule").Cells(StartRow, 1).Value = EstJobName(i)
The cells are referenced using Cells(StartRow, 1) Where StartRow was a pre-declared and pre-defined integer variable that specifies the row and "1" denotes the column.
EDIT:
Now, I want to change this code to reference the columns by the column HEADERS instead.
For example, the header of a column is: "Fab Hours Date", how do I reference that?
Yes, you can simply use the letter name for the column in quotes:
Cells(StartRow, "A")
Edited to answer your further question:
to look for a specific column name, try this:
columnNamesRow = 1 ' or whichever row your names are in
nameToSearch = "Fab Hours" ' or whatever name you want to search for
columnToUse = 0
lastUsedColumn = Worksheets("Foo").Cells(1, Worksheets("Foo").Columns.Count).End(xlToLeft).Column
For col = 1 To lastUsedColumn
If Worksheets("Foo").Cells(columnNamesRow, col).Value = nameToSearch Then
columnToUse = col
End If
Next col
If columnToUse > 0 Then
' found the column you wanted, do your thing here using "columnToUse" as the column index
End If
Here are two different functions to get what you want. To use them, you'd have to put them in your code.
Function ColumnNumberByHeader(text As String, Optional headerRange As Range) As Long
Dim foundRange As Range
If (headerRange Is Nothing) Then
Set headerRange = Range("1:1")
End If
Set foundRange = headerRange.Find(text)
If (foundRange Is Nothing) Then
MsgBox "Could not find column that matches header: " & text, vbCritical, "Header Not Found"
ColumnNumberByHeader = 0
Else
ColumnNumberByHeader = foundRange.Column
End If
End Function
Function ColumnNumberByHeader2(text As String, Optional headerRange As Range) As Long
If (headerRange Is Nothing) Then
Set headerRange = Range("1:1")
End If
On Error Resume Next
ColumnNumberByHeader2 = WorksheetFunction.Match(text, headerRange, False)
If Err.Number <> 0 Then
MsgBox "Could not find column that matches header: " & text, vbCritical, "Header Not Found"
ColumnNumberByHeader2 = 0
End If
On Error GoTo 0
End Function
Example Calls:
ColumnNumberByHeader ("Extn")
ColumnNumberByHeader("1718", Range("2:2"))
Or in your case:
ProductionWorkBook.Sheets("Production Schedule"). _
Cells(StartRow, ColumnNumberByHeader("Fab Hours Date")).Value = EstJobName(i)
ProductionWorkBook.Sheets("Production Schedule").Range("A" & StartRow).Value = EstJobName(i)
Unless you mean the column is a named range you defined?
ProductionWorkBook.Sheets("Production Schedule").Range("E"& StartRow).Value = ...
will do the job.
Though keep in mind that using hard coded references like the column letter will risk that the macro breaks when the sheet is edited (e.g. a column is inserted). It's therefore better to use a named range and Offset to access:
ProductionWorkBook.Sheets("Production Schedule").Range("StartCell").Offset(StartRow-1).Value
Now you only need to provide the name StartCellto your fist cell (make sure that it's a local name in the Name Manager)