I am performing a linear interpolation for my class project. I have created an interpolation function and have to perform calculation dynamically, as the number of column varies for each problem. So, I have retrieved the value for last column(ltr) and trying to concatenate it with R1C1 format. But it doesn’t work. Could you please suggest some idea, how do workaround for this issue.
Please find below the following code:
Private Sub TrialCheck_Click()
Dim lrt As Double
With ActiveSheet
'retrives last column i.e lrt = 447
lrt = .Cells(.Rows.Count, "F").End(xlUp).Row
End With
Range("I3").Value = Range("F3").Value * Range("B3").Value
Range("I58").Value = Range("F" & lrt).Value * Range("B58").Value
'MacroR
'following works as 447 is hardcoded
'Range("I4").Value = _
"=(LinInterp(RC[-8],R4C[-4]:R447C[-4],R4C[-3]:R447C[-3])*RC[-7])"
'following code doesn't concatenate value of lrt
Range("I4").Value = _
"=(LinInterp(RC[-8],R4C[-4]:R&lrt&C[-4],R4C[-3]:R&lrt&C[-3])*RC[-7])"
Range("J4").Select
Range("I4").AutoFill Destination:=Range("I4:I57"), Type:=xlFillDefault
Range("I4:I57").Select
End Sub
you have to do string concatenation
"string" & lrt & "string" & lrt & "string"
Range("I4").Value = _
"=(LinInterp(RC[-8],R4C[-4]:R" & lrt & "C[-4],R4C[-3]:R" & lrt & "C[-3])*RC[-7])"
Related
Hi I am writing a code for sum the data based on criteria. The below code working perfectly but it not return value. The code works on the excel like this (= SUMIF($B$1:$DC$1,p,B2:DD2). The reason is Criteria P Need double quotation.how to add the double quotation to P and any suggestion would be appreciated
Sub ashok()
Dim LR As Long
Dim Rg, Rg1 As Range
ActiveSheet.Range("a1").Select
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.NumberFormat = "0"
ActiveSheet.Range("a1").Select
Set Rg = Range("b1", ActiveSheet.Range("A1").End(xlToRight))
Set Rg1 = Range("b2", ActiveSheet.Range("A2").End(xlToRight))
Range("a1").End(xlToRight).Select
With ActiveCell.Offset(1, 1).Resize(LR)
.Formula = "= SumIf(" & Rg.Address(True, True) & "," & "P" & "," & Rg1.Address(False, False) & ")"
End With
End Sub
The answer to your question is use Chr(34):
.Formula = "= SumIf(" & Rg.Address(True, True) & "," & Chr(34) & "P" & Chr(34) & "," & Rg1.Address(False, False) & ")"
However, you have way too much (unnecessary and should stay away from) use of Select, ActiveSheet, ActiveCell and Selection.
An example of how your code could look if you use fully qualified objects:
With Sheets("Sheet3") ' <-- replace with your sheet's name
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns("A:A").EntireColumn.NumberFormat = "0"
Set Rg = .Range("B1", .Range("A1").End(xlToRight)) '<-- NOT SURE this make sense !
Set Rg1 = .Range("B2", .Range("A2").End(xlToRight)) '<-- NOT SURE this make sense !
' etc. etc.
End With ' closing the With
I want to put double quotes inside all cells in a particular column.
I have wrote the code to put double quotes but the problem is it is putting 3 double quotes around the value.
For Each myCell In ActiveWorkbook.Sheets("Sheet1").Range("B:B")
If myCell.Value <> "" Then
myCell.Value = Chr(34) & myCell.Value & Chr(34)
End If
Next myCell
The basic requirement is to split the excel file according to column B and save them as CSV files.
In the split filed, the values of column B and D must be enclosed within double quotes.
Full Code :
Option Explicit
Sub ParseItems()
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String
Dim myCell As Range, transCell As Range
'Sheet with data in it
Set ws = Sheets("Sheet1")
'Path to save files into, remember the final \
SvPath = "D:\SplitExcel\"
'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
'Inserting new row to act as title, copying the data from first row in title, row deleted after use
ws.Range("A1").EntireRow.Insert
ws.Rows(2).EntireRow.Copy
ws.Range("A1").Select
ws.Paste
vTitles = "A1:Z1"
'Choose column to evaluate from, column A = 1, B = 2, etc.
vCol = 2
If vCol = 0 Then Exit Sub
'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
'Speed up macro execution
Application.ScreenUpdating = False
'Get a temporary list of unique values from key column
ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True
'Sort the temporary list
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))
'clear temporary worksheet list
ws.Range("EE:EE").Clear
'Turn on the autofilter, one column only is all that is needed
'ws.Range(vTitles).AutoFilter
'Loop through list one value at a time
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)
'transCell = ws.Range("A2:A" & LR)
ws.Range("A2:A" & LR).EntireRow.Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Cells.Columns.AutoFit
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1
For Each myCell In ActiveWorkbook.Sheets("Sheet1").Range("B:B")
If myCell.Value <> "" Then
myCell.Value = Chr(34) & myCell.Value & Chr(34)
End If
Next myCell
ActiveWorkbook.SaveAs SvPath & "po" & MyArr(Itm) & ActiveWorkbook.Sheets("Sheet1").Range("D1") & "." & Date2Julian(Date), xlCSV, local:=False
ActiveWorkbook.Close False
ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm
'Cleanup
ws.Rows(1).EntireRow.Delete
ws.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
Function Date2Julian(ByVal vDate As Date) As String
Date2Julian = Format(DateDiff("d", CDate("01/01/" _
+ Format(Year(vDate), "0000")), vDate) _
+ 1, "000")
End Function
Sample Input Data :
24833837 8013 70 1105
25057089 8013 75 1105
25438741 8013 60 1105
24833837 8014 70 1106
25057089 8014 75 1106
25438741 8014 60 1106
Expected Output is Two files created with following data
File 1 :
24833837,"8013",70,1105
25057089,"8013",75,1105
25438741,"8013",60,1105
File 2:
24833837,"8014",70,1106
25057089,"8014",75,1106
25438741,"8014",60,1106
Resultant Output :
File 1 :
24833837,"""8013""",70,1105
25057089,"""8013""",75,1105
25438741,"""8013""",60,1105
Same for File 2
Kindly help. :)
Afaik, there is no simple way to trick Excel into using quotes around numbers when using the normal "save as csv"-procedure. You can, however, use VBA to save in whatever csv format you like.
Take code example from https://support.microsoft.com/en-us/help/291296/procedure-to-export-a-text-file-with-both-comma-and-quote-delimiters-in-excel
Just add an if-statement to determine whether to use quotes or not
' Write current cell's text to file with quotation marks.
If WorksheetFunction.IsText(Selection.Cells(RowCount, ColumnCount)) Then
Print #FileNum, """" & Selection.Cells(RowCount, _
ColumnCount).Text & """";
Else
Print #FileNum, Selection.Cells(RowCount, _
ColumnCount).Text;
End If
The WorksheetFunction.IsText will recognize your numbers as text if they are entered with a preceding ' (single high quote)
You would need to adjust the example to export the range you want with the pre-given filename from your code.
This little sub will do as you need. Just give it a filename fname, range to export as csv rg and a column number column_with_quotes - so something like this but with a range to suit:
save_as_csv_with_optional_quotes SvPath & "po" & MyArr(Itm) & ActiveWorkbook.Sheets("Sheet1").Range("D1") & "." & Date2Julian(Date), Range("A1:C5"), 2
Here is the sub:
Sub save_as_csv_with_optional_quotes(fname As String, rg As Range, column_with_quotes As Long)
Dim ff, r, c As Long
Dim loutput, cl As String
ff = FreeFile
Open fname For Output As ff
For r = 1 To rg.Rows.Count
loutput = ""
For c = 1 To rg.Columns.Count
If loutput <> "" Then loutput = loutput & ","
cl = rg.Cells(r, c).Value
If c = column_with_quotes Then cl = Chr$(34) & cl & Chr$(34)
loutput = loutput & cl
Next c
Print #ff, loutput
Next r
Close ff
End Sub
the problem is this line.
myCell.Value = Chr(34) & myCell.Value & Chr(34)
The quotes you are adding are then being quoted again when you export as CSV, hence three quotes each side of the value. A better option I think would be to change the number format of the myCell to be Text, rather than number. I haven't tried this but I think changing it to this should help.
myCell.Value = Chr(39) & myCell.Value
Chr(39) is an apostrophe and when you enter it as the first character of a cell value it forces the format to be Text.
Hey guys I need help with my novice skills at VBA code writing. I would like to modify the code below to accommodate the varying ranges of data rows for my sum range and criteria range in a SUMIF statment.
Sub sumifstate ()
Set critRange = Range("K2", Selection.End(xlUp).Offset(-1, 0)).Select
Set sumRange = Range("L2", Selection.End(xlUp).Offset(-1, 0)).Select
Set critRange2 = Range("M2", Selection.End(xlUp).Offset(-1, 0)).Select
Set sumRange2 = Range("N2", Selection.End(xlUp).Offset(-1, 0)).Select
Range("K41").Select
ActiveCell.FormulaR1C1 = _
"= (SUMIF("critRange",""*DF*"","sumRange")+SUMIF("critRange2,""*DF*"","sumRange2")"
End Sub ()
I hope I was specific enough if not let me know what other information you might need. Thank you!
There is no guarantee that all four of those columns have data in the same last row. However, each SUMIF requires that all ranges have the same size. Use the same formula for each of the pairs. You are also not evaluating hte formula within VBA, merely constructing a string together. You can use the ranges' addresses as strings for this.
Sub sumifstate()
Dim lr As Long, critRange As String, sumRange As String, critRange2 As String, sumRange2 As String
lr = Cells(Rows.Count, "L").End(xlUp).Row
critRange = Range("K2:K" & lr).Address
sumRange = Range("L2:L" & lr).Address
lr = Cells(Rows.Count, "N").End(xlUp).Row
critRange2 = Range("M2:M" & lr).Address
sumRange2 = Range("N2:N" & lr).Address
Range("K41").Formula = _
"=SUMIF(" & critRange & ", ""*DF*"", " & sumRange & ")+SUMIF(" & critRange2 & ", ""*DF*"", " & sumRange2 & ")"
End Sub
The formula produced will be dynamic but in this format.
=SUMIF($K$2:$K$10, "*DF*", $L$2:$L$10)+SUMIF($M$2:$M$10, "*DF*", $N$2:$N$10)
Hi,
So where you've got R[-39] or R[-3], you want to insert a variable for your actual calculated rows?
intStartRow = GetStartRow() ' i.e. however you define it, set a variable
intEndRow = GetEndRow()
Then replace where needed:
ActiveCell.FormulaR1C1 = _
"=(SUMIF(R[" & intStartRow & "]C:R[" & intEndRow & "]C, ...
i.e. use concatenate symbol "&",
Either that or use "=Offset" formula combined with Counta: that allows you to have "growing/shrinking" ranges without having to rerun your code
I have been trying to code a countif function into a loop, however, I am having a little trouble with the outputs. Instead of reading a number when the computation occurs, the function keeps outputting "true" or "false". Maybe there is an error in my code, but I have used many countif functions in the past without experiencing a problem such as this. As you can see below, I tried to write the function in two different ways, but both either didn't work or outputted "true" or "false".
Please Help.
Sub CorrectSets()
Dim Cell As Range
Range("B100000").End(xlUp).Select
LastRow = ActiveCell.Row
For Each Cell In Range("S2:S" & LastRow)
StartTime = Cell.Offset(0, -12)
Shift = Cell.Offset(0, -14)
SortedOp = Cell.Offset(0, -17)
DOW = Cell.Offset(0, -5)
'Cell.Value = CountIF(E2:E & LastRow, Shift, N2:N & LastRow ,DOW, B2:B & LastRow,SortedOp, G2:G & LastRow, " < " & StartTime)
Cell.Value = "=CountIF(E2:E" & LastRow & ", " & Shift & ", N2:N" & LastRow & "," & DOW & ", B2:B" & LastRow & "," & SortedOp & ", G2:G" & LastRow & ", " < " " & StartTime & ")"
Next Cell
If you want to put a countif() Formula in Cell then:
Cell.Formula = "=CountIF(E2:E &...............
If you want to put the formula's result in Cell then:
Cell.Value = Application.Worksheetfunction.CountIF(E2:E &....................
You should use
Cell.Formula = "=CountIFs..."
or
Cell.Value = WorksheetFunction.CountIfs...
See official documentation.
Plus:
To find the last row containing data in a column (B in this case) use
Dim ws as Worksheet
Set ws = ActiveSheet
Dim LastRow as Long
LastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
ws is a reference to the Worksheet of interest (ActiveSheet in my example).
See this answer.
You'd rather fully qualify your ranges, and avoid using Select unless it is strictly needed.
With the code posted above,
Range("B100000").End(xlUp).Select
might not be needed.
If using Cell.Formula = "=CountIFs...", it might be convenient to use
Dim frm as String
frm = "=CountIFs..."
Cell.Formula = frm
for easier debugging.
I have VBA code which converts a given specific date format into a normal Date. Is there a way in which I can replace the entire column into my new date format may be by a button click or just using a function.
The code I have is:
Function CONVDATE(myDate) As Date
Dim arr
arr = Split(myDate)
CONVDATE = arr(1) & " " & arr(2) & " " & arr(5) & " " & arr(3)
End Function
Immediately to the right of your data enter:
=TEXT(LEFT(A1,11)&RIGHT(A1,4),"ddd mm dd yyyy")
and double-click the fill handle. Then select, Copy and Paste Special Values over the top.
If you want a VBA solution, and you are happy with your CONVDATE function, you can use something like the following to convert an entire column:
===================================
Option Explicit
Sub CONVALLDATES()
Dim RNG As Range, C As Range
'Next line may change depending on how your range to convert is set up
Set RNG = Range("A1", Cells(Rows.Count, "A").End(xlUp))
'Uncomment next line when debugged.
'application.ScreenUpdating = False
For Each C In RNG
With C
.Value = CONVDATE(C)
'.numberformat = whatever format you want it displayed
End With
Next C
Application.ScreenUpdating = True
End Sub
'---------------------------------------------
Function CONVDATE(myDate) As Date
Dim arr
arr = Split(myDate)
CONVDATE = arr(1) & " " & arr(2) & " " & arr(5) & " " & arr(3)
End Function
====================================
You should add some error checking to ensure the string you are trying to convert is, indeed, in the specific format.