i have small problem with workbook "data_base" ...after copying the data to another sheet the formula in column "D" should show
like this below
"=IF([#[Time Out]]="","",([Time Out]-[Time In])*24)"
but its showing as below
"=IF(TTM_Form.xlsm!Table2[#[Time Out]]="","",(TTM_Form.xlsm!Table2[Time Out]-TTM_Form.xlsm!Table2[Time In])*24)"
and i am not getting the proper results ...can you please let me know how to avoid it.
code line below
.SpecialCells(xlCellTypeVisible).Copy Destination:=Destination.Range("A1")
You could try something like:
Destination.Range("A1").Formula = Origin.Range("F1").Formula
If you have table and column names in your formula, naturally you will have the same table and column names after copy/paste.
Suppose that your table layout is as follows:
1- You can either manually amend the formula as =IF(E2="","",(E2-F2)*24) and then copy/paste with your code.
2- Or you can have the code do it for you:
Sub cpy()
Sheets("Sheet2").Range("D2").Formula = str(Sheets("Sheet1").Range("D2"))
End Sub
Function str(rng As Range) As String
Dim brakets As Object, regEx As Object
Dim colname As String, colletter As String
Dim i As Long, colno As Long, rowno As Long
Set regEx = CreateObject("vbscript.regexp")
str = rng.Formula
With regEx
.Global = True
.Pattern = "\[(.*?)\]"
Set brakets = .Execute(str)
For i = 0 To brakets.count - 1
colname = Replace(Replace(Replace(brakets(i).submatches(0), "#", ""), "[", ""), "]", "")
colno = Application.WorksheetFunction.Match(colname, Sheets(rng.Parent.Name).Rows(1), 0)
colletter = Split(Cells(1, colno).Address(True, False), "$")(0)
rowno = rng.Row
str = Replace(str, brakets(i), colletter & rowno)
Next i
End With
str = Replace(Replace(Replace(str, "#", ""), "[", ""), "]", "")
End Function
Related
I have multiple row with different strings in which I want to filter data which are in this order
"DI then numbers" i.e DI07493A.
Column values are as such below:
01LICIN
05LICIN
AARHUSK
DI07493A
ABS16
DICOFDI
DI94193A
I am trying like this.
sheet1.Range("A1:A" & LastRow).AutoFilter Field:=4, Criteria1:= DI & #, Operator:=xlFilterValues
its not working. Is there a way to get this result?
Try the following:
Have a column (lets say A1:A8) with a header (for example called Header) and then the values.
Then on column B, have the same header and the values from B2:B11 be DI0*, DI1*, DI2*, DI3*, DI4*, DI5*, DI6*, DI7*, DI8*, DI9*.
Then apply the AdvancedFilter with the code:
Range("A1:A8").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("B1:B11").
Second Try with .Find
Sub find_my_stuff()
Dim xFoundCell as Variant
Dim Runner as Long
Dim SomeString as String
Set xFound Cell = Sheets("Sheet1").Range("A1:A" & LastRow).Find("DI", lookat:=xlPart_
, MatchCase:=True
Sheets("Sheet2").Range("A" & Runner) = xFoundCell.Address
SomeString = Sheets("Sheet2").Range("A" & Runner)
SomeString = Replace(SomeString, "A", "")
SomeString = Replace(SomeString, "$", "")
Sheets("Sheet2").Range("B" & Runner) = SomeString
Sheets("Sheet2").Range("C" & Runner) = Sheets("sheet1").Cells(SomeString,1)
End Sub
As I said... super ugly, but maybe you can get an Idea what I tried to acomplish
You just need to add an asterix to the relevant part of your substring.
In your code, change this: Criteria1 := DI*
Try this code:
Sub Filter()
Dim lastRow As Long, i As Long, ws As Worksheet
Set ws = Worksheets("sheet_name")
With ws
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
'this conition checks if cell contains "DI" followed by a digit
If Not Left(.Cells(i, 1).Value, 3) Like "DI[0-9]" Then
.Rows(i).Hidden = True
End If
Next
End With
End Sub
I am writing a little Excel-Macro with VBA. Now I would like to concat two Strings and save them into a String-Array.
What I got:
Dim rowNumberString As String
Dim colIndexString As String
Dim headerArray(1 To colIndexArrayRange) As String
colIndexNumber = 14
colCount = 5
rowNumberString = "12"
addAnotherColumnToArray = True
' Fill the column array with all the month's entries
While addAnotherColumnToArray
colCount = colCount + 1
colIndexNumber = colIndexNumber + 1
If colIndexArray(colCount) = "" Then
colIndexString = Split(Cells(1, colIndexNumber).Address(True, False), "$")(0)
colIndexArray(colCount) = colIndexString & rowNumberString
End If
Debug.Print colCount & "=" & colIndexArray(colCount)
If (colIndexNumber > 61) Then
addAnotherColumnToArray = False
End If
Wend
The output:
6=O
7=P
8=Q
9=R
10=S
11=T
12=U
' ....
So it seems that this line:
` colIndexArray(colCount) = colIndexString & rowNumberString`
is not concatenating the String the way it should. What did I do wrong? I thought the &-Operator would always work for Strings in VBA.
As I stated in my comment, you could be going about this in a completely different way.
Not sure what you are trying to accomplish, but a For...Next statement using Objects, rather than Strings should help you accomplish your task.
Option Explicit
Sub TEST()
Dim ws As Worksheet, Rng12 As Range, Cell As Range
Set ws = ThisWorkbook.Worksheets(1)
Set Rng12 = ws.Range("L12:Z12") 'Adjust your range
For Each Cell In Rng12
Debug.Print Cell.Address
Next Cell
End Sub
I need help with excel.
I have a column with hundreds of cells that I need to combine into one cell.
The values in the cells are already centered. Also, some cells have multiple values that are stacked on top of each other using (ALT + ENTER).
I need to choose a range of these cells and combine them and stack them on top of each other into one cell.
If I can also get rid of extra "new lines" between the values as well as repeated values that would be an added bonus.
Here is a picture of what it looks like and what I'm aiming at. I've been trying to learn vbscript and macros, but this is on a bit of a deadline. I appreciate the help.
The following shows you how to combine all numbers from a column into a single cell in VBA Excel, which is what I assume the coding language you are using.
There are two Procedures I use: 1) a columnCombine() Sub and 2) a Custom Split() Function courtesy of Wade Tai of Microsoft
Link to Wade's Article with Split Function: http://msdn.microsoft.com/en-us/library/aa155763%28office.10%29.aspx
columnCombine() Sub:
Sub columnCombine()
'variables needed:
Dim col As Integer
Dim startRow As Integer
Dim endRow As Integer
Dim firstCell As Range
Dim lastCell As Range
Dim i As Integer
Dim s As Variant
Dim destinationCell As Range
Dim strg As Variant
Dim strgTemp() As String
'enter first and last cells of column of interest in the "A1/A2/A3..." format below:'
Set firstCell = Range("A1") 'this can be what you want
Set lastCell = Range("A3") 'this can be what you want
'enter destination cell in same format as above
Set destinationCell = Range("B1") 'this can be what you want
'get column of interest
col = firstCell.Column
'get start row and end row
startRow = firstCell.Row
endRow = lastCell.Row
'set temp string
strg = ""
For i = startRow To endRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = strg & vbNewLine & s
End If
Next s
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg
End Sub
Split() Function:
Public Function Split(ByVal InputText As String, _
Optional ByVal Delimiter As String) As Variant
' This function splits the sentence in InputText into
' words and returns a string array of the words. Each
' element of the array contains one word.
' This constant contains punctuation and characters
' that should be filtered from the input string.
Const CHARS = "!?,;:""'()[]{}"
Dim strReplacedText As String
Dim intIndex As Integer
' Replace tab characters with space characters.
strReplacedText = Trim(Replace(InputText, _
vbTab, " "))
' Filter all specified characters from the string.
For intIndex = 1 To Len(CHARS)
strReplacedText = Trim(Replace(strReplacedText, _
Mid(CHARS, intIndex, 1), " "))
Next intIndex
' Loop until all consecutive space characters are
' replaced by a single space character.
Do While InStr(strReplacedText, " ")
strReplacedText = Replace(strReplacedText, _
" ", " ")
Loop
' Split the sentence into an array of words and return
' the array. If a delimiter is specified, use it.
'MsgBox "String:" & strReplacedText
If Len(Delimiter) = 0 Then
Split = VBA.Split(strReplacedText)
Else
Split = VBA.Split(strReplacedText, Delimiter)
End If
End Function
*UPDATE:
If you desire to use this on multiple different columns with the intention of moving everything to one cell, use this code recursively or in some repetitive manner e.g. write a script that uses columnCombine to combine the column sections you are referencing into different cells in one column. Then run the program again (or as many times as you need) so that you get the data into one cell.
If you want to change the order in which you iterate through a column e.g. you want to iterate from A4 to A1 instead of A1 to A4, just change For i = startRow To endRow to For i = endRow To startRow.
Note this will not change the order of organization of data within an individual cell, only a whole column. In other words, {["hello","Hello"],["One"],["Two", "Three"]} would become {["Two","Three"],["One"],["hello","Hello"]}
To change the order within a cell, you would need to either alter the For Each statement in columnCombine() or
manually change the order of strg. Both of which are not to hard to do.
Here is a solution I would do:
Add this in addition to the current variables :
Dim strg2 As Variant
strg2 = ""
Change this code:
For i = startRow To endRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = strg & vbNewLine & s
End If
Next s
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg
To:
For i = endRow To startRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = s & vbNewLine & strg
End If
Next s
If strg2 = "" Then
strg2 = strg
Else
strg2 = strg2 & vbNewLine & strg
End If
strg = ""
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg2
Remember, this change is specific to iterating through items backward and reordering them backwards. The columnCombine() sub will very depending on how you want the data presented
I am using a formula to show a cells formula in another cell.
I want to show the values of each reference in this formula, instead of the reference.
Ex:
=$R$16+R19*($T$15-$R$16)
Want it to be
=3+2*(4-2)
Function I am using now to show formula as it is
Function GetFormula(Cell As Range) As String
GetFormula = Cell.Formula
End Function
Here is a very basic example which can handle cases like
=B1+C1-D1/E1
=$B$1+C1*($B$1-$D$1)
=B1+C1-(D1/E1)
=B1+C1-(D1/E1)
=$B$1*C1*($B$1/$D$1)
Assumptions:
Let's say the above formulas are in cell A1 to A5
All cells are in the same sheet
There is no worksheet function like SUM, Vlookup etc
No Error handling done. Assuming that you will take care of it
Sample Worksheet
Code:
Sub Sample()
Dim i As Long
For i = 1 To 5
Debug.Print ConvertToValues(Range("A" & i))
Next i
End Sub
Function ConvertToValues(rng As Range)
Dim sTmp As String, sOpr As String, sOrig As String
Dim s As String, v As String
Dim MyAr
Dim i As Long
sOpr = "+,/,-,*,&,(,),{,},[,]"
MyAr = Split(sOpr, ",")
sTmp = Replace(rng.Formula, "$", "")
sOrig = sTmp
For i = LBound(MyAr) To UBound(MyAr)
sTmp = Replace(sTmp, MyAr(i), "SIDROUT")
Next i
MyAr = Split(sTmp, "SIDROUT")
For i = LBound(MyAr) To UBound(MyAr)
s = MyAr(i)
If Len(Trim(s)) <> 0 Then
v = Range(s).Value
sOrig = Replace(sOrig, s, v)
End If
Next i
If sOrig <> "" Then _
ConvertToValues = "=" & sOrig
End Function
Output
Note:
Let me know if the above code fails in a particular scenario and I will update the code.
I have a spread sheet that look like so:
Group | Name | Title
-----------------------------------
X WS -
X DH -
X M -
X DH -
X WS -
I want to loop through all the cells in name and replace the initial there with their full name in addition to adding the correct title. My script is failing to accurately compare the strings and go into the if-statement:
Sub enterNameAndTitle()
lastCell = InputBox("Last cell")
rInitials = InputBox("Initials")
rFullName = InputBox("Full Name")
rTitle = InputBox("Title")
Dim cell As Range
For Each cell In Range("b2:b" & lastCell).Cells
MsgBox (cell.Text & " : " & rInitials)
If StrComp(UCase(cell.Value), UCase(rInitials)) = 0 Then
cell.Value = rFullName
ActiveSheet.Cells(cell.Row, cell.Column + 1).Value = rTitle
End If
Next cell
End Sub
So I first collect the data and then loop through all the values. Does anyone know what I am doing incorrectly? Why doesn't it compare the string accurately?
I don't see anything wrong, but there are 2 things I would try
One is to use TRIM to make sure neither string has leading or trailing blanks
The 2nd is to change the if to if(ucase(trim(cell.value))=ucase(trim(rInitials)))
The problem was one of differing types and the only way that seemed to work for me was to re-cast both variables as type String using CStr()
Sub enterNameAndTitle()
Dim lastCell As String
lastCell = InputBox("Last cell")
'Cast to string
Dim rInitials As String
rInitials = CStr(InputBox("Initials"))
Dim rFullName As String
rFullName = InputBox("Full Name")
Dim rTitle As String
rTitle = InputBox("Title")
Dim cell As Range
For Each cell In Range("b2:b" & lastCell).Cells
Dim cellText As String
'Cast to string
cellText = CStr(cell.Text)
If (Trim(UCase(cell.Value)) = Trim(UCase(rInitials))) Then
MsgBox ("test1")
cell.Value = rFullName
ActiveSheet.Cells(cell.Row, cell.Column + 1).Value = rTitle
End If
Next cell
End Sub