For i = 1 To 5
changeto = CStr(Sheet15.Cells(1, i).Formula)
newindustry = getfirstword(Worksheets("Industry Insert Template").Range("C1"))
'grab the index position of the comma and exclamation mark
intchangeto = InStr(changeto, ",")
finalchangeto = InStr(changeto, "!")
'extract the worksheet substring
finalindustry = Mid(changeto, intchangeto + 1, finalchangeto - intchangeto - 1)
If finalindustry <> "'Multiples & EPS'" And finalindustry <> "Technicals" Then
finalformula = Replace(changeto, finalindustry, newindustry)
Cells(1, i).Formula = finalformula
End If
Next
Currently this is my macro to adjust the worksheet name.
I want to adjust only the numerical reference.
For example:
=VLOOKUP($B1,Industrials!$CA$41:$GG$41,C$8)
I want to be able to change the cells 41 in the vlookup to reflect the correct row. How would I go through all the cells and change the formula to reflect this?
Use Replace:
Example :
Cells (1, i).Formula = Replace(Cells (1, i).Formula, oldRow, NewRow)
If the value of i is related to the row number, you can use it in place of old row etc.
Related
I have a macro that allows me to open multiple files based on their names and copy sheets based on a criteria (if there's a value in column "X" then copy the row but only some colums "F,G,P,Q,W,X,Y) to another unique workbook.
the problem is in column F i have a color and i want to retrieve the color index but the macro leaves it blank
[1] Get data from A1:Z{n}
n = ws.Range("A" & Rows.Count).End(xlUp).Row ' find last row number n
v = ws.Range("A10:Y" & n).Value2 ' get data cols A:Y and omit header row
[2] build array containing found rows
a = buildAr2(v, 24) ' search in column X = 24
' [3a] Row Filter based on criteria
v = Application.Transpose(Application.Index(v, _
a, _
Application.Evaluate("row(1:" & 26 & ")"))) ' all columns from A to Z
[3b] Column Filter F,G,P,Q,W,X,Y
v = Application.Transpose(Application.Transpose(Application.Index(v, _
Application.Evaluate("row(1:" & UBound(a) - LBound(a) + 1 & ")"), _
Array(6, 7, 16, 17, 23, 24, 25)))) ' only cols F,G,P,Q,W,X,Y
Function buildAr2(v, ByVal vColumn&, Optional criteria) As Variant
' Purpose: Helper function to check in Column X
' Note: called by main function MultiCriteria in section [2]
Dim found&, found2&, i&, j&, n&, ar: ReDim ar(0 To UBound(v) - 1)
howMany = 0 ' reset boolean value to default
For i = LBound(v) To UBound(v)
If Len(Trim(v(i, vColumn))) > 0 Then
ar(n) = i
n = n + 1
End If
Next i
If n < 2 Then
howMany = n: n = 2
Else
howMany = n
End If
ReDim Preserve ar(0 To n - 1)
buildAr2 = ar
End Function
How to copy filtered array values together with color format (column F)
You got the solution to filter a data field Array v by row AND column using the Application.Index property and write these data to a target sheet - c.f. Multi criteria selection with VBA
Your issue was to find a way to write not only data, but also the source color formatting of column F to the target cells, as an array per se contains values and no color info.
Write the filtered information to a defined STARTROW (e.g. 10), then you can use the item numbers of array a adding a headline offset headerIncrement) to reconstruct the source row numbers by a simple loop in order to get/write the color formats, too:
Code addition
' [4a] Copy results array to target sheet, e.g. start row at A10
Const STARTROW& = 10
ws2.Cells(STARTROW, 1).Offset(0, 0).Resize(UBound(v), UBound(v, 2)) = v
' **************************************************************************
' [4b] Copy color formats using available item number information in array a
' **************************************************************************
Dim sourceColumn&: sourceColumn = 6 ' <<~~ source column F = 6
Dim targetColumn&: targetColumn = 1 ' <<~~ becomes first target column
Dim headerIncrement&: headerIncrement = STARTROW - 1
For i = 0 To UBound(a)
ws2.Cells(i + headerIncrement, targetColumn).Offset(1, 26).Interior.Color = _
ws.Cells(a(i) + headerIncrement, sourceColumn).Interior.Color
Next i
Side Note Don't forget to set Option Explicit to force declaration of variables and to declare the variable howMany (used in both procedures) in the declaration head of your code module.
I have no idea where the problem is, but you asked:
the problem is in column F i have a color and i want to retrieve the
color index but the macro leaves it blank
Here's how you retrieve the colorindex from Cell A1:
col = Range("A1").Interior.ColorIndex
I would suggest you try retrieving it and if you run into a problem: open a question with your example, as Pᴇʜ suggested.
In addition to the comments above by #Pᴇʜ, the fact that you are mainly dealing with v, a variant array of strings, is going to be a limiting factor. You are going to have to deal with a Range if you want the .Interior.ColorIndex property of the cell (Range).
Also, if you want to be precise about the color, use color instead of ColorIndex.
ColorIndex will return the closest indexed color.
I've got an Excel file with N rows and M columns. Usually data are organized one per row, but it can happens that a data occupy more than a row. In this case how can I express that the second (or next) row has to refer to the first row?
In this example, AP.01 has got 5 rows of description, so how can I say that the other 4 rows refer also to the first code?
EDIT once that I did the association I have to export my Excel file into an Access DB. So I want to see the tables with the correct data.
If I have only one row for the description I wrote this code and it works:
If grid(r, 3).Text.Length > 255 Then
code.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
code.Description = grid(r, 3).Text.ToString
End If
Instead if I have more than one row for the description I wrote this code and it doesn't work:
Do While grid(r, 1).ToString = ""
If grid(r, 1).ToString = "" And grid(r, 3).ToString IsNot Nothing Then
Dim s As String
s = grid(r, 3).ToString
code.Description = grid((r - 1), 3).ToString & s
End If
Loop
If it is a one-off, try the below. This will basically put a formula in every cell that refers to the cell immediately above it:
Select column A (from top until bottom of list (row N)
Press ctrl + g to open the GoTo dialogue
Press Special
Select Blanks from the radio buttons
The above will select all the blank cells in column A. Now enter = and press up arrow. Enter the formula by holding down ctrl while pressing enter. That will enter the same formula in every cell.
Try
Sub Demo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet3") 'change Sheet3 to your data sheet
With .Range("A:A").SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
From your question I Guess that, you must be define a variable for last column Value. and check the value in respective column, if it is empty then use column value if not empty then take current value as last value.
'Dim LastValue as string
LastValue = sheet("SheetName").cells(i,"Column Name").value
for i = 2 to LastRow '>>>> here i am assume you run code in for loop from row to
'to last count row(LastRow as variable)
'Put your sheet name at "SheetName" and column index (like "A","B","C"...) at "Column Name"
if sheet("SheetName").cells(i,"Column Name").value <>"" then
LastValue = sheet("SheetName").cells(i,"Column Name").value
end if
'(Do your stuff using LastValue , you may generate lastvalue 1, lastvalue2 ..etc)
next'for loop end here
I have the below table in word that I'm trying to write a script to replace the contents of the below cell with a different customer payment (i.e replace the £1,100 with £2,000). Below is a snippet of my script but the when I write back to the cell it loses all the formatting and the numbered list.
How can I keep replace the cell data with very similar data and still keep the formatting?
ps. I've simplified the contents of the cell to make it easier to read, so the code won't apply to exactly that content
DescPlan = Trim(t1.Cell(2, 2).Range.Text)
DescTest = InStr(1, DescPlan, ":")
finalString = Left(DescPlan, DescTest)
t1.Cell(2, 2).Range.Text = Replace(DescPlan, finalString, "Payment by the customer of " + Format(v, "Currency") + " will be due upon completion of items below:")
Not sure if this helps but you are using a table so what works for excel should also work for you.
Sub replace_keep_format()
Dim t1 As Range
Dim sStrng As String, rStrng As String
Dim i As Integer
sStrng = "£1,100"
rStrng = "£2,000"
i = 1
Do Until ThisWorkbook.Sheets(1).Range("a" & i) = ""
Set t1 = ThisWorkbook.Sheets(1).Range("a" & i)
t1 = Replace(Expression:=t1, Find:=sStrng, Replace:=rStrng)
i = i + 1
Loop
End Sub
=IF(AND(G2<>100,TODAY()>=H2, TODAY()<=I2), E2, " ")
=IF(N2=" ", " ",NETWORKDAYS(H2,TODAY()))
=IF(OR(O2 = " ", O2 <= 0), " ", (O2/N2)*100)
These are the three formulas, I want to make sure that as they are inserted into the worksheet the cell references will still change to match the rows they are on, as they would in a normal spreadsheet. Any advice would be much appreciated! (To clarify, I need to fill the ranges using VBA as the code I'm using clears the worksheet every time it is run.)
you could use FormulaR1C1 property of range object, which uses the "R1C1" notation for range addresses
for instance inserting your first formula in "A1" would be:
Range("A1").FormulaR1C1 = "=IF(AND(RC7<>100,TODAY()>=RC8, TODAY()<=RC9), RC5, "" "")"
where the pure R would assume the current cell row index, while C7 stands for a fixed (not varying with host cell position) 7th column index reference, and so on
If i have interpreted your question correctly, you need something like the below:
Option Explicit
Sub InsertFormula()
Dim i As Long
Dim n As Long
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To n
Cells(i, 1).Formula = "=IF(AND(G2<>100,TODAY()>=H2, TODAY()<=I2), E2, "" "")"
Next i
End Sub
replace the 1 in n=... with whichever column has the most rows of data
replace for i = 1 to whichever row it must begin form
You will notice i have added extra quotations to the end of the formula, this is needed as quotes in a formula in VBA must be enclosed... in more quotes lol
Apply this concept for the other formulas :)
Instead of absolute references like G2 you can use something along
.FormulaR1C1 = "=SUM(RC[-2]:R[5]C[-2])"
where R and C reference the offset from the current cell (positive: right or down, negative: up or left).
Use it in a way similar to this:
Dim c
For Each c In Selection
c.FormulaR1C1 = "=SUM(RC[-2]:R[5]C[-2])"
Next c
Relative References are adjusted when you set the formula to range of cells:
[A1:B2].Formula = "=C$1" ' now the formula in B2 will become "=D$1"
You can also set multiple formulas at once:
Range("K2:M9").Formula = Array("=IF(AND(G2<>100,TODAY()>=H2, TODAY()<=I2), E2, "" "")", _
"=IF(N2="" "", "" "",NETWORKDAYS(H2,TODAY()))", _
"=IF(OR(O2 = "" "", O2 <= 0), "" "", (O2/N2)*100)" )
or if each row has different formula:
[A1:Z3] = [{"=1";"=2";"=3"}]
I have a column in a worksheet:
ColumnA
wer
rfvg
swe
dfe
I would like to create a string 'wer','rfvg','swe','dfe' for use in a TSQL query
SELECT value
FROM table
WHERE code IN ('wer','rfvg','swe','dfe')
What I do now:
1. put CONCATENATE("'";A1;"',") in B1
2. drag it all the way down
3. copy+ paste the generated values in ColumnB into my query
What I get is this:
SELECT value
FROM table
WHERE code IN ('wer',
'rfvg',
'swe',
'dfe')
Since these last can contain up to 100 codes that is really annoying.
I would like to create a single continuous string in cell B1.
Is there a way to do this?
Thanx for thinking with me
Here is a macro to do this:
Sub BuildListForQuery
Dim oCells As Object, aCell As Object, oDoc As Object
Dim iColumnA As Integer, sList As String
oDoc = ThisComponent
iColumnA = 0
oColumn = oDoc.Sheets(0).Columns(iColumnA)
oRanges = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
oRanges.insertByName("", oColumn)
oCells = oRanges.Cells.createEnumeration
If Not oCells.hasMoreElements Then Print "Sorry, no text to display"
While oCells.hasMoreElements
aCell = oCells.nextElement
If sList = "" Then
sList = "'" + aCell.String + "'"
Else
sList = sList + ",'" + aCell.String + "'"
End If
Wend
aCell = oDoc.Sheets(0).getCellRangeByName("B1")
aCell.setString(sList)
End Sub
Result in B1 is 'wer','rfvg','swe','dfe'.
How about this:
Put in C1 =CONCATENATE("'",A1,"'")
Put in D1 =CONCATENATE(B1,",'",INDIRECT("A" & COLUMN()-2),"'")
COLUMN returns a number for the column: A is 1, B is 2, etc.
INDIRECT takes a string entry and returns the contents of a cell address, in this case the contents of the cell in column A, row [calculated from column number]. So column D (4) looks at row 2 (4 - 2), column E (5) looks at row 3 (5 - 2), etc.
Copy and paste D1 over however many columns you want (100 columns would be to column CX)
Put in some other cell, we'll say B3 for purposes of this post, =COUNTA(A1:A100) to show how many entries you have in column A
In B1 (the cell where you want the final string) put the formula =INDIRECT(ADDRESS(1,B3+2)) - of course replace B3 with wherever you actually put the COUNTA formula
ADDRESS takes (row number, column number) - here [row 1, column (however many entries in column A + 2)] and returns a LetterNumber cell address