I'm trying to extract the first 8 characters of a string while also inserting a "/" into the 8th character position using .FormulaR1C1. But, I don't think I have the concatenate function written quite right.
I need
MK442LLA-PB-3RC
to become
MK442LL/A
The R1C1 concatenate formula I used is as follows:
With Range("D2")
.FormulaR1C1 = "=CONCATENATE(LEFT(RC[-1], 7)""/""MID(RC[-1], 8, 1))"
.AutoFill Destination:=Range("D2:D" & lastRow)
End With
Note: I'm using Mid() instead of Right() because the initial numbers vary in length.
How about this instead of using '.FormulaR1C1'? Offset accordingly..
Sub concatFirstEight()
'last row
lastRow = range("D1048576").end(xlup).row
'set your range
Set concatRange = Range("D2:D" & lastRow)
'loop through range and add a "/" between the 7th and 8th character
For Each c In concatRange
c.Value = Mid(c, 1, 7) & "/" & Mid(c, 8, 1)
Next
End Sub
Related
I am running a Loop to capture the start of Range and end of Range for a particular scenario. After I find my start range and end range, I want to put it as a formula in a cell. For example:
Cells(1,1).Formula "= Min( startrange:endrange)"
The above code has assumed the variables as text and instead of putting the cell address these variables are handling, it is pasting the formula as text like this : '= Min( startrange:endrange)'
I have no idea and have tried different approaches I could get from internet like below
' cells(4,4).formula = "=Min("&startrage& :"" & endrange & ")""
' Cells(4, 4).Formula = "=Min(startrange.value :endrange)"
'Cells(4, 4).Formula = Application.WorksheetFunction.Min(startrange:endrange)
' Cells(4, 4).Formula = "=Min("&startrange&"&":"& " &endrange&")"
where
startrange = ActiveCell.Offset(1, 3).Address(0, 0)
endrange = ActiveCell.Offset(0, 3).Address(0, 0)
Nothing works.
How can I achieve this? Specially I am also facing error in handling ":".
cells(4,4).formula = "=Min(" & startrage & ":" & endrange & ")"
I have the following formula:
=IF(IFERROR(MATCH($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$A$49,0),0),VLOOKUP($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$B$49,2,FALSE),0)
In A1 I have another date: 10.10.2016
How can I replace only the date that is in the file name from the formula?
Until now, I've been using this:
Sub modify()
Dim a As Range
Set a = Range("a1")
[e3:e4].Replace "dones 05.10.2016.xls", ("dones " & a & ".xls"), xlPart
End Sub
The problem that in A2 I have another date and F3:F4 must have the date from A2, and so on until A300. How can I replace only the date of the file name in the formula?
The names of the files are standard: dones dd.mm.yyyy.xls
Sub modify()
Dim c As Range, r As Range
Set c = [a1]
Set r = [e3:e4]
Application.DisplayAlerts = False ' optional to hide dialogs
While c > ""
Debug.Print c.Address(0, 0), r.Address(0, 0) ' optional to check the address
r.Replace "[dones ??.??.????.xls]", "[dones " & c & ".xls]", xlPart
Set c = c.Offset(1, 0) ' A1 to A2
Set r = r.Offset(0, 1) ' E3:E4 to F3:F4
Wend
Application.DisplayAlerts = True
End Sub
Replace with wildcards:
[e3:e4].Replace "[dones ??.??.????.xls]", "[dones " & [a1] & ".xls]", xlPart
? matches any single character and * can be used to match 0 or more characters:
[e3:e4].Replace "[*.xls*]", "[dones " & [a1] & ".xls]", xlPart
https://www.ablebits.com/office-addins-blog/2015/09/29/using-excel-find-replace/#find-replace-wildcards
Instead of hard-coding "dones 05.10.2016.xls", you'll have to build that string from the cell values. Also, you'll need some looping logic to track which row you're reading from and which column you're writing to.
Assuming a date read in row 1 goes in column 5, a date read in row 2 goes in column 6, and so on, something like this should be good enough:
Dim targetColumn As Long
Dim sourceRow As Long
With ActiveSheet
For sourceRow = 1 To WhateverTheLastRowIs
targetColumn = 4 + sourceRow 'column 5 / "E" for sourceRow 1
Dim sourceDateValue As Variant
sourceDateValue = .Cells(sourceRow, 1).Value
Debug.Assert VarType(sourceDateValue) = vbDate
Dim formattedSourceDate As String
formattedSourceDate = Format(sourceDateValue.Value, "MM.DD.YYYY")
'replace string in rows 3 & 4 of targetColumn:
.Range(.Cells(3, targetColumn), .Cells(4, targetColumn) _
.Replace "[*.xls]", "[dones " & formattedSourceDate & ".xls]", xlPart
Next
End With
My understanding of the requirements is this:
There is a List of Dates in Column A starting at Row 1
A formula needs to be entered in rows 3:4 starting in Column E and moving one column to the right for each value in the List of Dates, i.e. Formula in column E has date from row 1, column F has date from row 2, …
This is the formula, in which the date 05.10.2016 in the filename '\\share\done\[dones 05.10.2016.xls]done should be update with corresponding value from the List of Dates as per point 2.
=IF(
IFERROR(MATCH($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$A$49,0),0),
VLOOKUP($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$B$49,2,FALSE),0)
This solution assumes the dates in column A are already formated as required by the filename link.
This solution uses a variable to hold the Link Formula and another variable to update the Link Formula with each Value in the List of Dates.
Also to simplify the update\replacement of the date let’s change the original date in the formula for 05.10.2016 for an unique key such as #DATE
Dim sFmlLink As String, sFml As String
sFmlLink = "=IF(" & Chr(10) & _
"IFERROR(MATCH($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,0),0)," & Chr(10) & _
"VLOOKUP($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,2,FALSE),0)"
Then we set a Range with the List of Dates and loop trough it to update and enter the formula as per point 2.
Sub FormulaLink()
Dim sFmlLink As String, sFml As String
sFmlLink = "=IF(" & Chr(10) & _
"IFERROR(MATCH($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,0),0)," & Chr(10) & _
"VLOOKUP($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,2,FALSE),0)"
Dim rDates As Range, lRow As Long, iCol As Integer
Rem Set Start Column
iCol = 5
With ThisWorkbook.Sheets("DATA")
Rem Set Dates List Range
Set rDates = Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp))
Rem Enter Link Formula in Rows 3:4, starting at Column 5
Rem and moving one column to the right for each Date in Column A
For lRow = 1 To rDates.Rows.Count
Rem Refresh Link Formula with Date from Column A
sFml = Replace(sFmlLink, "#DATE", rDates.Cells(lRow).Value)
Rem Enter Formula in Column iCol Rows 3:4
.Cells(3, iCol).Resize(2).Formula = sFml
Rem Move One Column to the right
iCol = 1 + iCol
Next: End With
End Sub
You will need to work with the string functions InStr and Mid here. Maybe this can help you:
Dim str As String
Dim intPos1 As Integer
Dim intPos2 As Integer
Dim intLastPos As Integer
'Formula as string
str = "\\share\done\[dones 05-10-2016.xls]done'!$A$2:$A$49,0),0),VLOOKUP($C3,'\\share\done\[dones 05-10-2016.xls]done"
'Get the start and the End Position of the First Excel File
intPos1 = InStr(1, str, "[dones") - 1
intPos2 = InStr(1, str, ".xls") + 5
'Save the Last Postion for the second Replacement
intLastPos = intPos2
'Replace old File with [dones 01-10-1911.xls]
str = Mid(str, 1, intPos1) & "[dones 01-10-1911.xls]" & Mid(str, intPos2, Len(str))
'Get the start and the End Position of the second Excel File
intPos1 = InStr(intLastPos, str, "[dones")
intPos2 = InStr(intLastPos, str, ".xls")
'Replace the second File with [dones 01-10-1911.xls]
str = Mid(str, 1, intPos1) & "[dones 01-10-1911.xls]" & Mid(str, intPos2, Len(str))
After that you can read back the formula.
I'm developing a worksheet users can fill out to generate a file that can be uploaded into SAP.
The worksheet will generate a mass upload of individual entries. Users will be asked to provide attributes for each line item they are requesting, which may vary based on the selection made (i.e. one row may have 5 attributes while the next may have 7).
I want to write a macro that will look at each row, starting from the top, and concatenate only the attribute columns (which are separated by two other columns in each instance) which are not blank and use a delimiter between each field.
I've been able to use some code I found through Microsoft to get the looping done (see below), but I can't figure out how to have the concatenate stop when a column is blank and then move to the next row.
Sub Submit()
Range("C2").Activate
Do While ActiveCell <> ""
ActiveCell.Offset(0, 21).FormulaR1C1 = _
ActiveCell.Offset(0, 0) & "-" & ActiveCell.Offset(0, 3) & "-" &
ActiveCell.Offset(0, 6) & "-" & ActiveCell.Offset(0, 9) & "-" & ActiveCell.Offset(0, 12) & "-" & ActiveCell.Offset(0, 15) & "-" & ActiveCell.Offset(0, 18)
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Right now, this code will take a five attribute entry and leave me with "1-2-3-4-5--", when I really want it to show up as "1-2-3-4-5".
Any thoughts on how I can go about doing this? Eventually, I want to be able to store those strings and populate them in a new workbook with some other information copied over from the original workbook.
Untested:
Sub Submit()
Dim c As Range, c2 As Range, v as String
Set c = Range("C2")
Do While c.Value <> ""
Set c2 = c
v = ""
Do While c2.value <> ""
v = v & IIf(v <> "", "-", "") & c2.value
Set c2 = c2.offset(0, 3)
Loop
c.offset(0, 21).Value = v
Set c = c.Offset(1, 0)
Loop
End Sub
This is a quick answer, so may not have everything you're after:
Public Function Submit(Target As Range) As String
Dim sFinalOutput As String
Dim rCell As Range
'Cylce through each cell in your range.
For Each rCell In Target
'Look at the column number divided by 3 - if it's 0 then carry on.
If rCell.Column Mod 3 = 0 Then
If rCell.Value2 <> "" Then
'Grab the value from the cell and add it to the final output.
sFinalOutput = sFinalOutput & "-" & rCell.Value2
End If
End If
Next rCell
Submit = sFinalOutput
End Function
Use it in a formula such as: =submit(C4:L4)
Sub BatchCopyTextNewColumn()
Dim LastRow As Integer
'Variables declared as per Solution from http://stackoverflow.com/questions/24967189 /vba-'decimal-issue-after-replacing-a-hyphen-with-dot
'by Jagadish Dabbiru (July 25, 2014)
Dim i As Integer
Dim BatchNo() As String
Dim ArrBatchNo As Long
Worksheets("DataFile").Activate
Cells(1, 17).Select
'Rename Columns
Cells(1, 17).Value = "BatchNumeric"
Cells(1, 18).Select
'Rename Columns
Cells(1, 18).Value = "BatchCheck_Old_New"
'Ask user to provide you with the Batch# from the last data set e.g. which was received a week ago.
'Last Row is defined by the Column 1 "AccountString"
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("O2", Range("O1").End(xlDown))
.Copy
End With
'Use the PasteSpecial method:
Range("Q2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Solution from http://stackoverflow.com/questions/24967189/vba-decimal-issue-after-'replacing-a-hyphen-with-dot
'by Jagadish Dabbiru (July 25, 2014)
'Take each value from column q and Split the batch code with delimiter hyphen(-).
'Then check the length of the value of 2nd array element.
'If length is 1 digit then add 0 as prefix else keep as it is.
i = 1
Do
BatchNo = Worksheets("DataFile").Range("Q" & i).Value
ArrBatchNo = Split(BatchNo, "-")
If Len(ArrBatchNo(1)) = 1 Then
ArrBatchNo = "0" & ArrBatchNo
End If
Worksheets("DataFile").Range("Q" & i).Value = ArrBatchNo(0) & "." & ArrBatchNo(1)
i = i + 1
Loop While Worksheets("DataFile").Range("Q" & i).Value <> ""
Range("Q2").Activate
End Sub
There is a problem with decimals after replacing hyphens with dots.
Originally the Batch numbers are issued with hyphens. I need to use them as values as I have to distinguish between "OLD" Batch numbers (sent previously) and "NEW" (larger than the last Batch number).
Hyphen replacement (my code):
Sub ReplaceBatchCharacter()
Range("Q2").Activate
Worksheets("DataFile").Columns("Q").Replace _
'I tried to replace it with "." and there is a problem with decimals as well (e.g. batch # 4230-1 and 4230-10 are both shown as 4210.10 after replacement
What:="-", Replacement:=".0", _
'by replacing with ".0" I have solution for batch #'s xxxx-1/2/3/4/5/6/7/8/9 but when it starts with double digits xxxx-10 etc I have similar problem as they become xxxx.010 etc.
So the batch number 4230-1 and 4230-10 are both shown as 4210.010 after replacement.
SearchOrder:=xlByColumns, MatchCase:=True
End Sub
Check Old and New Batch # (my code):
Sub BatchNumberCheckNewOld()
Dim BatchNumberPrevious As Single
Dim BatchNumberCurrentCell As Range
Dim BatchNumberCurrentRange As Range
Dim BatchNumberCurrentResult As String
Dim LastRow As Long
'Dim ChangedRange As Range
Worksheets("DataFile").Activate
Range("Q2").Activate
LastRow = Cells(Rows.Count, 17).End(xlUp).Row
'Ask user to provide us with the Batch# from the last data set e.g. which was received a week ago.
'Last Row is defined by the Column 1 "AccountString"
'BatchNumberPrevious = 4250.1
BatchNumberPrevious = InputBox("Please enter the last Batch # from previous period. Don't forget to reconcile TB's (prior and current months). Ocassionally OLD batches could be NEW.")
Set BatchNumberCurrentRange = Range(Cells(2, 17), Cells(LastRow, 17))
For Each BatchNumberCurrentCell In BatchNumberCurrentRange
If BatchNumberPrevious >= BatchNumberCurrentCell.Value Then
BatchNumberCurrentResult = "Old"
Else
BatchNumberCurrentResult = "New"
End If
'BatchNumberCurrentResult column should be populated by offsetting BatchNumberCurrentCell variable
BatchNumberCurrentCell.Offset(0, 1).Value = BatchNumberCurrentResult
Next BatchNumberCurrentCell
'Autofit width of columns
ActiveSheet.UsedRange.Columns.AutoFit
End Sub
Take each value from column q and Split the batch code with delimiter hyphen(-). Then check the length of the value of 2nd array element. If length is 1 digit then add 0 as prefix else keep as it is.
i =1
Do
BatchNo = Worksheets("DataFile").Range("Q"& i).Value
ArrBatchNo = Split(BatchNo,"-")
If Len(ArrBatchNo(1)) = 1 Then
ArrBatchNo(1) = "0" & ArrBatchNo (1)
End If
Worksheets("DataFile").Range("Q"& i).Value = ArrBatchNo(0) & "." & ArrBatchNo(1)
i = i+1
Loop While Worksheets("DataFile").Range("Q"& i).Value <> ""
This program is to convert a column of data from cumulative to non-cumulative. On my sheet I have A1, B1, and C1 with the text Non-Cumulative, Cumulative, and Converted, respectively. I have numbers 1 to 10 beneath A1, then them summed cumulatively beneath B1. C1 is where I want to convert column B back to non-cumulative.
The IsNumeric is used to make the first row of data in C equal to the first row of data in B. It should detect that the title is above the number it is evaluating, thus knowing that no calculations have to be performed. For the rest of them, it'll see that the number above the one it is evaluating is a number, and thus the calculation has to be done.
My problem is that it isn't working. I think the reason is because IsNumeric() keeps coming back as false. Is there a different function I should be using? Do cell references not work in IsNumeric?
Here's the program!
Option Explicit
Dim i As Variant
Sub Conversion()
Sheets("Test Sheet").Select
For i = 1 To 10
If IsNumeric("B" & i) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next
End Sub
The way you wrote your code is logical, just a minor syntax changes you need initially. However,
It's also best to check if the range is empty first...
Then check on if the value is numeric.
Better even, if you set the Range into a Range object and use offset
Code:
Option Explicit '-- great that you use explicit declaration :)
Sub Conversion()
Dim i As Integer '-- integer is good enough
Dim rngRange as Range
'-- try not to select anything. And for a cleaner code
Set rngRange = Sheets("Test Sheet").Range("B1")
For i = 1 To 10
If (rangeRange.Offset(i,0).value) <> "" then '-- check for non-empty
If IsNumeric(rangeRange.Offset(i,0).value) = False Then
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0)
Else
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0) - rangeRange.Offset(i-1,0)
End If
End if
Next i '-- loop
End Sub
To make your code more dynamic:
Another suggestion, you may simply Application.WorkSheetFunction.Transpose() the entire B column range that you need to validate into a variant array
Process the array and Transpose back to the Range with column B and C.
By doing so, you may omit setting for loop size manually but setting it using Lower and Upper bound of the array ;)
You need to check if the range of B i is numeric, not the string "B" & i
and rather than selecting the sheet, simply using a parent identifier like:
sheets("sheet1").range("B" & i)
This will help you avoid errors in your code
For i = 1 To 10
If IsNumeric(sheets("test sheet").range("B" & i).value) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next