Creating a list of named ranges for every sheet - excel

There are many things similar but not exactly my issue. I'm trying to name ranges off of each tab based upon details of the tab name. I have placed the tab names in one sheet and now want to define named ranges based upon these cells. I can't get it to like my range names with a variable.
Sub Test()
Dim x As Integer
Dim y As String
Dim YY As String
Dim z As String
Dim ZZ As String
For x = 1 To Worksheets.Count
Sheets("List of Tab Names").Activate
y = Cells(x, 1).Value
z = Cells(x, 2).Value
YY = y & "Data2"
ZZ = z & "YoA2"
Sheets(y).Activate
Range("C9:BG233").Name = " ' " & YY & " ' "
Range("C7:BG7").Name = " ' " & ZZ & " ' "
Next x
End Sub

You don't need the single quotes around the range names. Just try:
Range("C9:BG233").Name = YY
Range("C7:BG7").Name = ZZ

If I have got your idea right i think all you are missing is the function Worksheets(sheetname)
As you can see in the code here:
Range("A1:A5").Name = Worksheets("Sheet2").Range("A1")

Related

Nested Conditions In VBA

I am new to excel and VBA so apologies for silly question or mistake.
i have some 2000 excel data in sheet2 and the data req in sheet 1
I need to know how many ticket which starts with INC and priority P2 P3 are there and same way how many tickets which starts with SR are there. also out of them how many are in closed state and how many are active.
Sub US_Data()
Dim z As Long
Dim C As Range
z = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(z, 1))
If Left(C.Value, 3) = "INC" Then
Sheet1.Cells(8, 6) = Sheet1.Cells(8, 6) + 1
End If
Next C
End Sub
Thank you
Why use VBA at all? This can be done with simple formulas. If you don't want to use pivot tables, manually create the headings (Blue in the screenshot), then put this formula into cell H3, copy across and down.
=COUNTIFS($A:$A,$G3&"*",$B:$B,H$1,$C:$C,H$2)
Change the layout if you want. The point is that you don't need VBA for that. Formulas will be a lot faster than re-inventing a CountIfs with VBA.
Sub US_Data()
Dim z As Long
Dim HighCount as Long
Dim ModerCount as Long
Dim LowCount as Long
Dim OpenCount as Long
Dim ClosedCount as Long
Dim C As Range
z = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(z, 1))
If Left(C.Value, 3) = "INC" Then
If C.Offset(0,1).Value = "2 - High" Then HighCount = HighCount + 1
If C.Offset(0,1).Value = "3 - Moderate" Then ModerCount = ModerCount + 1
If C.Offset(0,1).Value = "4 - Low" Then LowCount = LowCount + 1
If C.Offset(0,2).Value = "Closed" Then ClosedCount = ClosedCount + 1
If C.Offset(0,2).Value = "Open" Then OpenCount = OpenCount + 1
End If
Next C
MsgBox "I have counted " & HighCount & " times High, " & ModerCount & " times Moderate, " & LowCount & " times Low, and respectively " & OpenCount & " and " & ClosedCount & " open and closed instances.", vbOkOnly, "FYI"
Sheet1.Cells(8, 6) = HighCount
End Sub
This would be one way of doing it, you can fill the cells necessary with those variables.

How to split number formula in Excel cells to individual columns?

I need help in solving the problem:
Formula in Excel cell is like this-> =20000-17000+1000 , I need to split the figures in different columns like this-> 20000 | 17000 | 1000 , no problem with removing + / -, I can live without them. Unable to find any help hence posted here.
Thanking in advance.example given
CTR+H and change sign - into whatever unique like # then replace + the same way into #.
After having 20000#17000#1000use:
Data/Text to columns/Delimited/Other and type #
You may record a macro to have it automated.
This Sub can do it:
Public Sub SplitSum(rngInput As Range, rngOutputStart As Range)
Dim varParts As Variant: varParts = Split(Replace(Replace(Mid(rngInput.Formula, 2), "-", "|"), "+", "|"), "|")
Dim c As Long: For c = LBound(varParts) To UBound(varParts)
rngOutputStart.offset(0, c - LBound(varParts)).Value = CDbl(varParts(c))
Next c
End Sub
You can use it like this:
SplitSum ActiveCell, ActiveCell.Offset(0, 1)
This function will preserve the sign before your numbers and has been written simply so as to permit you easy access for further tweaking if necessary.
Sub SumsToColumns(Rng As Range)
Dim RngVal As String
Dim Vals() As String
Dim n As Integer
RngVal = Trim(Rng.Cells(1).Formula)
If Len(RngVal) Then
RngVal = Mid(Replace(RngVal, "+ ", "+"), 2)
RngVal = Replace(RngVal, " +", " +")
RngVal = Replace(RngVal, "- ", "-")
RngVal = Replace(RngVal, "-", " -")
Do
n = Len(RngVal)
RngVal = Replace(RngVal, " ", " ")
Loop While Len(RngVal) < n
Vals = Split(RngVal)
For n = 0 To UBound(Vals)
With Rng
.Worksheet.Cells(.Row, .Column + n + 2).Value = Vals(n)
End With
Next n
End If
End Sub
You can call this function with a line like this:-
SumsToColumns(Range("G13"))
where "G13" is a range you might extract from a simple procedure that loops through all cells in a column. Please take note of the following line in the code.
.Worksheet.Cells(.Row, .Column + n + 2).Value
It specifies that the result should be written in the same worksheet as where the Range("G13") was taken from, in the same row (13 in this case) and starting 2 columns to the right, in this case "G" + 2 columns = "I". You can modify the "2" to any offset you might require. The result will be split over as many columns as there are separate numbers in G13.

Excel VBA Loop Rows Until Empty Cell

I have an Excel document with some plain text in a row. The cells in the range A1:A5 contain texts, then a hundred of rows down there's another few rows with text. Cells between are empty.
I've set up a Do Until loop which is supposed to copy cells with text, and then stop when an empty cell appears. My loop counts and copies 136 cells including the 5 with text.
So my question is why?
The bottom line: Hello ends up on line 136, and then there's a huge gap of empty cells until next area with text. Do the 131 white cells contain any hidden formatting causing this?
I've tried "Clear Formats" and "Clear All". I've also tried using vbNullString instead of " ".
Code snippet:
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Integer, y As Integer
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
Do Until assets.Worksheets(1).Range("A" & x) = ""
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
x = x + 1
y = y + 1
Loop
test.Worksheets(1).Range("A" & x).Value = "Hello"
End Sub
Use a For Next Statement terminating in the last used cell in column A. Only increment y if there has been a value found and transferred and let the For ... Next increment x.
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Long, y As Long
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
with assets.Worksheets(1)
for x = 1 to .cells(rows.count, 1).end(xlup).row
if cbool(len(.Range("A" & x).value2)) then
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
y = y + 1
end if
next x
test.Worksheets(1).Range("A" & y).Value = "Hello"
end with
End Sub

Find a matching suburb in an address

I have an Excel sheet with a list of addresses on each line
i.e.
COLUMN A
My Company 123 Big Street Ashgrove QLD 4111
A Better Compant PO Box 123 Sandgate QLD 4111
I have another sheet with every QLD suburb in it in alphabetical order in a named range called rSuburbs
i.e.
Ashgrove
BBBB
CCC
Sandgate
Zilmere
What formula can I write to find the closest match and dump it out, i.e. like this:
COLUMN A COLUMN B
My Company 123 Big Street Ashgrove QLD 4111 Ashgrove
A Better Compant PO Box 123 Sandgate QLD 4111 Sandgate
Try this formula in B2 copied down
=LOOKUP(2^15,SEARCH(" "&rSuburbs&" "," "&A2&" "),rSuburbs)
Using " "& ensures that you don't get partial matches
Assuming your list of suburbs is in column K2:6 with the heading suburbs in K1:
{=INDEX(K:K,LARGE(IFERROR(FIND($K$2:$K$6,A2)*0+ROW(A$2:A$6),0),1))}
Array formulas must be confirmed with ctrl+shift+enter -- do not try to enter the squiggly braces manually!
This will return the desired output.
Basically, figure out if each of the list is in the text in column A, return the row number of the suburb if it is, or zero if it isn't, and take the suburb of the largest index you get.
If you are interested in a vba solution this will print the suburb name in Column B, amend to match your workbook.
Option Explicit
Sub splitlr()
Dim wb As Workbook
Dim ws As Worksheet
Dim s As String, str As String
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim lr As Long
Dim a As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
With ws
a = 1
Do Until a = lr
s = .Range("A" & a).Text
i = Len(s)
j = InStrRev(s, " ") - 1
k = InStrRev(s, " ", j) - 1
l = InStrRev(s, " ", k)
str = Mid(s, l, (i - k))
.Range("B" & a).Value = str
a = a + 1
Loop
End With
End Sub

Disconnect between address assigned in code to named range and the resulting named range address

I am trying to write a VBA script in Excel 2003 (not my choice of version) to partition a predefined range on a worksheet into ten named ranges. The worksheet name is "paste_data" and the 'block' of cells that I want to confine the script to is A4:AO111. Sometimes, when I run the script, it works, but at other times, it seems to shift the effective starting cell from A4 to another cell. Here is an example of bad results (sorry, I can't post an image because I'm new):
The named range table.emergency.count refers to range V6:AO25 when it should refer to range V4:AO23.
My code is here:
Sub tables_assign()
Dim j As Integer
Dim range_ref, range_name, rref As String
Dim tbles(1 To 10) As String
Dim rw1, rw2 As Integer
'##########################################################################################
'CREATION AND NAMING OF TABLES
'##########################################################################################
tbles(1) = "table.emergency.score": tbles(2) = "table.emergency.count": tbles(3) = "table.eol.score": tbles(4) = "table.eol.count": tbles(5) = "table.inpatient.score": tbles(6) = "table.inpatient.count": tbles(7) = "table.outpatient.score": tbles(8) = "table.outpatient.count": tbles(9) = "table.sds.score": tbles(10) = "table.sds.count"
For j = 1 To 10
If j Mod 2 <> 0 Then
If j = 1 Then
rw1 = 4
rw2 = 23
Else
rw1 = 4 + 22 * Application.WorksheetFunction.Ceiling((j / 2 - 1), 1)
rw2 = 23 + 22 * Application.WorksheetFunction.Ceiling((j / 2 - 1), 1)
End If
rref = Trim(Application.WorksheetFunction.Substitute("=paste_data!A" & Str(rw1) & ":T" & Str(rw2), " ", ""))
ActiveWorkbook.Names.Add tbles(j), rref
Else
If j = 2 Then
rw1 = 4
rw2 = 23
Else
rw1 = 4 + 22 * (j / 2 - 1)
rw2 = 23 + 22 * (j / 2 - 1)
End If
rref = Trim(Application.WorksheetFunction.Substitute("=paste_data!V" & Str(rw1) & ":AO" & Str(rw2), " ", ""))
ActiveWorkbook.Names.Add tbles(j), rref
End If
Next j
End Sub
Does anyone have an idea why this would happen? My hunch is that the worksheet's 'usedrange' is the culprit.
When you use relative references in defined names, the definition is relative to the activecell. To avoid that, use absolute references, like $V$4:$AO$23. With absolute references, the named range will always point to the same cells.
Example:
Select cell A1 and define the name test_relative as "=A1". Now select cell B10 and reopen the defined name box, select test_relative and you'll see something like "=Sheet1!B10"
To fix your code, insert the $ in the range references
rref = Trim(Replace("=paste_data!$A$" & Str(rw1) & ":$T$" & Str(rw2), " ", ""))
Also note that
Dim rw1, rw2 As Integer
dimensions rw1 as a Variant. Use
Dim rw1 As Integer, rw2 As Integer

Resources