I have made a simple program to put a particular formula in Excel. The problem is the occurrence of single inverted quotes in the result.
Where the result should be ='[Fiber Loss Report - 7210 DCN.xlsx]1310'!G9,
the result i get is ='[Fiber Loss Report - 7210 DCN.xlsx]1310'!'G9'
Sub CopyValues()
Dim n As Integer
Dim y As Integer
Dim rng As Range
y = 6
For n = 9 To 175
rngText = "D" & y
Range(rngText).Select
'rng.Select
'Range("D6").Select
formulaText = "='[Fiber Loss Report - 7210 DCN.xlsx]1310'!G" & n
ActiveCell.FormulaR1C1 = formulaText
rngText = "E" & y
Range(rngText).Select
formulaText = "='[Fiber Loss Report - 7210 DCN.xlsx]1310'!G" & n + 1
ActiveCell.FormulaR1C1 = formulaText
n = n + 2
y = y + 1
Next
End Sub
Please let me know on how can I avoid the occurrence of these single quotes.
Further to my comments below your question...
You need to find trends in your code. That ways you can avoid the loops.
For example, your formula from D6 to D61 increase from G9 to G12 to G15 and so on. Similarly for Col E.
So there is a trend. The next question you can ask yourself is "What formula can I write where I can get results like 9, 12, 15, 18 and so on?". The formula is
=(ROW()-3)*3
If you put that formula say in G6 and pull it down, you will get that sequence.
Now also instead of looping we can write formula to the entire range is one go. So we simply combine the above with Indirect. See this
Shortest possible code?
Sub CopyValues()
Dim ws As Worksheet
Dim fName As String
fName = "Fiber Loss Report - 7210 DCN.xlsx"
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'"='[Fiber Loss Report - 7210 DCN.xlsx]1310'!G9"
.Range("D6:D61").Formula = "=INDIRECT(" & Chr(34) & "'[" & _
fName & "]1310'!G" & Chr(34) & _
" & (ROW()-3)*3)"
.Range("E6:E61").Formula = "=INDIRECT(" & Chr(34) & "'[" & _
fName & "]1310'!G" & Chr(34) & _
" & (ROW()-3)*3+1)"
End With
End Sub
JUST FOR FUN
I can convert the above code in just two lines. Simply replace Sheet1 with the relevant sheet name.
Sub CopyValues()
ThisWorkbook.Sheets("Sheet1").Range("D6:D61").Formula = "=INDIRECT(" & Chr(34) & "'[Fiber Loss Report - 7210 DCN.xlsx]1310'!G" & Chr(34) & " & (ROW()-3)*3)"
ThisWorkbook.Sheets("Sheet1").Range("E6:E61").Formula = "=INDIRECT(" & Chr(34) & "'[Fiber Loss Report - 7210 DCN.xlsx]1310'!G" & Chr(34) & " & (ROW()-3)*3+1)"
End Sub
Option Explicit
Sub CopyValues()
Dim i As Long, j As Long
j = 6
For i = 9 To 175 Step 3
Range("D" & j).Formula = "='[Fiber Loss Report - 7210 DCN.xlsx]1310'!G" & i
Range("E" & j).Formula = "='[Fiber Loss Report - 7210 DCN.xlsx]1310'!G" & i + 1
j = j + 1
Next
End Sub
Result: ='[Fiber Loss Report - 7210 DCN.xlsx]1310'!G9
You can just remove single inverted quotes and change to RC format:
Sub CopyValues()
Dim n As Integer
Dim y As Integer
Dim rng As Range
y = 6
For n = 9 To 175
rngText = "D" & y
Range(rngText).Select
'rng.Select
'Range("D6").Select
formulaText = "=[Fiber Loss Report - 7210 DCN.xlsx]1310!R" & n & "C7"
ActiveCell.FormulaR1C1 = formulaText
rngText = "E" & y
Range(rngText).Select
formulaText = "=[Fiber Loss Report - 7210 DCN.xlsx]1310!R" & n + 1 & "C7"
ActiveCell.FormulaR1C1 = formulaText
n = n + 2
y = y + 1
Next
End Sub
Using .value instead of .FormulaR1C1 solves the problem. :)
Related
I want to insert a vlookup into a range of cells that is defined by variables.
My problem is that the search criteria (I gave the variable the name x) in the vlookup needs to be in " ", else the vlookup doesnt work.
But if I insert those " " into the formula in any way VBA thinks I'm trying to let it take x as a value.
Does anyone know how I can solve this problem?
If there is anything else wrong with the code, please tell me too, I'm new to this.
Sub FindExchange()
n = Worksheets.Count
For k = n To 6 Step -1
Dim ws As Worksheet
Set ws = Worksheets(k)
Dim lColumn As Long
lColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
For i = lColumn To 1 Step -4
Dim lrow As Long
lrow = ws.Cells(Rows.Count, i).End(xlUp).Row
x = Cells(1, i).Value
ws.Range(Cells(2, i + 2), Cells(lrow, i + 2)).FormulaLocal = "=vlookup(" & x & ";Sheet1!$B$2:$C$832;2;FALSE)"
Next i
Next k
End Sub
You can try this solution ,
"=vlookup(""" & x & """,Sheet1!$B$2:$C$832,2,FALSE)"
"=vlookup(" & """" & x & """" & ";Sheet1!$B$2:$C$832;2;FALSE)"
to get the double quotes " just add Chr(34).
change your FormulaLocal string to:
"=VLookup(" & chr(34) & x & chr(34) & ";Sheet1!$B$2:$C$832;2;FALSE)"
I was wondering if there is a way to split a cell with for example 6000 words into 1000 word pieces. So for example, 1000 words in cell C1, then the next 1000 words in C2 and so on.
Here is the code I have so far.
The output of that code (Cell C1) should be split, with C6 with 1000 words, C7 with 1000 words and so on until no more words are available.
Thank you in advance!
Option Explicit
Option Base 1
Dim dStr As String, aCell As Range
Dim cet, i As Long
Sub countWords()
Application.ScreenUpdating = False
Dim iniWords As Long, lWords As Long
Dim wK As Worksheet
On Error GoTo Err
Set wK = ActiveSheet
dStr = Join(WorksheetFunction.Transpose(wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).Value), " ")
'iniWords = WorksheetFunction.CountA(wK.Range("A1:A" & wK.Rows.Count))
cet = Split(dStr, " ")
iniWords = UBound(cet)
wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
'lWords = WorksheetFunction.CountA(wK.Range("A1:A" & wK.Rows.Count))
dStr = Join(WorksheetFunction.Transpose(wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).Value), " ")
cet = Split(dStr, " ")
dStr = ""
For i = LBound(cet) To UBound(cet)
If Trim(cet(i)) <> "" And InStr(dStr, Trim(cet(i))) = 0 Then
dStr = Trim(dStr) & " " & Trim(cet(i))
End If
Next i
dStr = Trim(dStr)
cet = Split(dStr, " ")
lWords = UBound(cet)
wK.Range("C1") = dStr
Application.ScreenUpdating = True
MsgBox "Words: " & iniWords & vbNewLine & _
"Removed duplicates " & iniWords - lWords & vbNewLine & _
"Remaining Words " & lWords
Exit Sub
Err:
MsgBox "There is no data in row A"
End Sub
you could use this:
Option Explicit
Sub main()
Const NWORDS As Long = 100 '<--| it's the number of words you want each cell to be written with. change it to your needs
Dim strng As String
Dim rowOffset As Long
With Range("C1")
strng = .Value
rowOffset = 5 '<--| point to C7 at the first iteration
Do
strng = Replace(strng, " ", "|", , NWORDS) '<--| "mark" the first NWORDS with a different separator (be sure pipe ("|") is not a character you can have in your words)
.Offset(rowOffset).Value = Replace(Left(strng, InStrRev(strng, "|") - 1), "|", " ") '<--| write first NWORDS words in current 'rowoffset' cell
strng = Right(strng, Len(strng) - InStrRev(strng, "|"))
rowOffset = rowOffset + 1 '<--| update row offset
Loop While UBound(Split(strng, " ")) > NWORDS - 1
.Offset(rowOffset).Value = strng
End With
End Sub
I’m applying a formula:
Textual representation of formula:
=(SUBSTITUTE((LEFT(A2;(FIND("htt";A2;1))-3));";";";"))&RIGHT(A2;(LEN(A2)-(FIND("htt";A2;1))+3))
to all cells in a range A2:A10, writing a result to range B2:B10 respectively.
To do this I use the following macro:
Sub ColumnsFormat()
Dim s As String
Dim i As Integer, j As Integer
'Set wb = Workbooks("CSV_File.xlsm")
Application.ScreenUpdating = False
j = 1
For i = 2 To 10
s = "=(SUBSTITUTE((LEFT(R[" & Trim(Str(i)) & "]C[" & Trim(Str(j - 2)) & "],(FIND(""htt"",R[" & Trim(Str(i)) & "]C[" & Trim(Str(j - 2)) & "],1))-3)),"","","";""))&RIGHT(R[" & Trim(Str(i)) & "]C[" & Trim(Str(j - 2)) & "],(LEN(R[" & Trim(Str(i)) & "]C[" & Trim(Str(j - 2)) & "])-(FIND(""htt"",R[" & Trim(Str(i)) & "]C[" & Trim(Str(j - 2)) & "],1))+3))"
Sheets("Sheet1").Cells(i, 2).Value = s
Next i
End Sub
The problem is that for some reason a row number inside the formula inside a For cycle is wrong. Instead of taking A2; A3; A4 … A10 cells, (changing row number by 1 each time), macro runs through A2; A4; A6 etc. (increasing a row number by 2 each time).
What am I doing wrong?
By changing the row in the formula to 0 the code works just fine. I guess the problem is that in your formula the row was calculated relative to the specific cell the formula was afterwards applied to. Therefore the formula in B2 looked at A(2+2), in B3 at A(3+3) and so on.
Sub ColumnsFormat()
Dim s As String
Dim i As Integer, j As Integer
'Set wb = Workbooks("CSV_File.xlsm")
Application.ScreenUpdating = False
j = 1
For i = 2 To 10
s = "=(SUBSTITUTE((LEFT(R[" & 0 & "]C[" & j - 2 & "],(FIND(""htt"",R[" & 0 & "]C[" & Trim(Str(j - 2)) & "],1))-3)),"","","";""))&RIGHT(R[" & 0 & "]C[" & Trim(Str(j - 2)) & "],(LEN(R[" & 0 & "]C[" & Trim(Str(j - 2)) & "])-(FIND(""htt"",R[" & 0 & "]C[" & Trim(Str(j - 2)) & "],1))+3))"
Sheets("Sheet1").Cells(i, 2).Value = s
Next i
End Sub
I've been looking to write a macro to check 3 columns to ensure the contents are a date value. The columns can contain empty cells.
The below returns a message box for each cell that is not a date, even the blanks.
Sub DateCheck()
With ActiveSheet
lastRow = .Range("AB" & Rows.Count).End(xlUp).Row
For RowCount = 2 To lastRow
POC = .Range("AB" & RowCount)
If Not IsDate(POC) Then
MsgBox ("Please enter valid date in Cell : AB" & RowCount & ". Example: dd/mm/yyyy")
End If
Next RowCount
End With
End Sub
Could anybody be so kind as to help to adjust this to look at 3 non-adjacent columns, ignore blank cells and only return one message per column in the event it finds non-date values?
Thanks as always
Chris
Code:
Sub DateCheck()
Dim s(2) As String
Dim i As Integer
Dim o As String
Dim lastRow As Long
Dim r As Long
'Enter columns here:
s(0) = "A"
s(1) = "B"
s(2) = "C"
For i = 0 To 2
With ActiveSheet
lastRow = .Range(s(i) & Rows.Count).End(xlUp).Row
For r = 2 To lastRow
POC = .Range(s(i) & r)
If Not IsDate(POC) Then
o = o & ", " & .Range(s(i) & r).Address
End If
Next r
MsgBox ("Please enter valid date in Cells : " & Right(o, Len(o) - 1) & ". Example: dd/mm/yyyy")
o = ""
End With
Next i
End Sub
I would change your loop to a For Each In ... Next and use .Union to construct a range of non-adjacent columns.
Sub MultiDateCheck()
Dim lr As Long, cl As Range, rng As Range, mssg As String
With ActiveSheet
lr = .Range("AB" & Rows.Count).End(xlUp).Row
Set rng = Union(.Range("AB2:AB" & lr), .Range("AM2:AM" & lr), .Range("AZ2:AZ" & lr))
For Each cl In rng
If Not IsDate(cl.Value) And Not IsEmpty(cl) Then _
mssg = mssg & cl.Address(0, 0) & Space(4)
Next cl
End With
If CBool(Len(mssg)) Then
MsgBox ("Please enter valid date(s) in Cell(s): " & Chr(10) & Chr(10) & _
mssg & Chr(10) & Chr(10) & _
"Example: dd/mm/yyyy")
Else
MsgBox "All dates completed!"
End If
Set rng = Nothing
End Sub
I've used a single lastrow from column AB to determined the scope of the cells to be examined but individual rows for each column could easily be compensated for.
Addendum: Code modified for a single message showing rogue non-date/non-blank cells (as below). The Chr(10) is simply a line feed character.
I am trying to select a cell in Excel VBA 2007
Example in row 2, cells A through H have some numbers but cell B2 has the highest value. is there a formula that I could use to get the address of the cell B2 ?
Based on this, is there a way I could use a variable to select a Range(":") ?
I am a newbie to VBA so any help would be much appreciated.
Thanks
=CELL("address",INDEX(A2:H2,MATCH(MAX(A2:H2),A2:H2,0)))
EDIT.
Sub max_value_address()
Dim i As Long
i = 2
'This example assigns to A1 cell the address of max value in the range a2:h2
Range("a1").Formula = "=CELL(""Address"",INDEX(A" & i & ":H" & i & ",MATCH(MAX(A" & i & ":H" & i & "),A" & i & ":H" & i & ",0)))"
End Sub
EDIT 2.
This version is a little bit more concise.
Sub max_value_address()
Dim i As Long
Dim str As String
i = 2
str = "a" & i & ":h" & i 'assign to str a2:h2
Range("a1").Formula = "=CELL(""address"",INDEX(" & str & ",MATCH(MAX(" & str & ")," & str & ",0)))"
End Sub
The below code might help you to reach your goal. Let us know if it's unclear.
Sub GetHigherValueCellAddress()
Dim oCell As Excel.Range
Dim oRange As Excel.Range
Dim vPrevValue As Variant
Dim sAddress As String
Set oRange = Sheets(1).Range("A1:C2")
For Each oCell In oRange
If oCell.Value > vPrevValue Then
sAddress = oCell.Address
vPrevValue = oCell.Value
End If
Next oCell
MsgBox sAddress
End Sub