I have to create a formula where say 3 columns are present A, B & C which has values till say serial 5. So now have to check If value in cell say C1 is blank then cell B1 would be A1/Count(C).
I am able to perform this for single cell but how can use below formula for range from A1:A5, B1:B5 and C1:C5
Sub CheckCnt()
Range("C6") = WorksheetFunction.CountA(Range("C1:C5"))
If Range("C1") = "" Then
Range("B1") = WorksheetFunction.Round(Range("A1") / Range("C6"), 2)
Else
Range("B1") = 0
End If
End Sub
Placing this into a FOR loop should work.
Please see Revised code below.
Sub CheckCnt()
Dim rw as Integer
Range("C6").Value = WorksheetFunction.CountA(Range("C1:C5"))
For rw = 1 to 5
If Range("C" & rw).Value = "" Then
Range("B" & rw).Value = WorksheetFunction.Round(Range("A" & rw).Value / Range("C6").Value, 2)
Else
Range("B" & rw).Value = 0
End If
Next rw
End Sub
Let me know if this works. Thanks so much!
I'm not sure exactly what formula looking to insert so I've placed the ROUND formula in the range B1:B5.
B1 will be: =ROUND($A1/$C$6,2)
B2 will be: =ROUND($A2/$C$6,2)
and so on...
This code uses the R1C1 notation:
Sub CheckCnt()
'Be specific about which sheet you want the result in (otherwise it will appear in the selected sheet).
With ThisWorkbook.Worksheets("Sheet1")
With .Range("B1:B5")
.FormulaR1C1 = "=Round(RC1/R6C3,2)" 'Use a formula with R1C1 notation.
.Value = .Value 'Replace the formula with the result of the formula.
End With
End With
End Sub
RC1 means this row, column 1. R6C3 means row 6, column 3.
http://www.numeritas.co.uk/2013/09/the-%E2%80%98dark-art%E2%80%99-of-r1c1-notation/
Related
I wrote a function which will concatenate all the cells to the left of the cell the function is in, using a delimiter. My code is:
Public Function Concat_To_Left(delim As String)
Dim C, R As Long
Dim S As String
Dim Cell As Range
Set Cell = ActiveCell
C = Cell.Column
R = Cell.Row
S = Cells(R, 1).Value
For i = 2 To (C - 1)
S = S & delim & Cells(R, i).Value
Next i
Concat_To_Left = S
End Function
This code works if calculating a single row. The problem I'm running into is that the cell.row and cell.column seem to be saved from the first cell when I fill the function to the bottom of a column (by double clicking the bottom right of the cell in the excel sheet). This results in all cells with this function having the same value as the cell being filled down from.
Screen-Updating, Events, and Alerts are all on/true. Application.Calculation is set to xlCalculationAutomatic
Can anyone tell me how to make this function work on each cell the formula is filled down into, using the proper row and column for each cell (not that column matters when filling down)?
Scott's comment about using TEXT join worked as a workaround to what I was trying to accomplish.
=TEXTJOIN(", ",TRUE,B2:INDEX(2:2,COLUMN()-1))
The link he provided to the custom code for TEXTJOIN was very nice as well:
MS Excel - Concat with a delimiter
Adding Application.Volatile did not make my function work. I did not find a way to get my function working with fill down without needing a range parameter, so TEXTJOIN is the next best option and answers my question for now.
EDIT:
I wrote this macro to work instead of a function:
Private Sub Concat_To_Left()
Dim C, R, LR As Long
Dim Cell As Range
LR = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
C = ActiveCell.Column
R = ActiveCell.Row
For Each Cell In ActiveWorkbook.ActiveSheet.Range(Cells(R, C), Cells(LR, C))
Cell.Value = Cells(Cell.Row, 1).Value
For i = 2 To (C - 1)
Cell.Value = Cell.Value & "|" & Cells(Cell.Row, i).Value
Next i
Next Cell
End Sub
This one uses "|" as a delimiter, fills down from the active cell to lastrow concatenating every cell to the left, including blanks.
I'm using the Excel VBA Editor (I have both Excel 2007 and Excel 2016). I have a variable parameter i, all the others are fixed.
Could you please say me how I can put a formula in a cell Cells(i, 2)?
using variables from my macro (j1, j2, i1)
using variables from my worksheet (the cells J1, J2, C[-1])
C[-1] being the cell left of Cells(i, 2) eg. Cells(i, 1)?
Thans a lot,
Eduard
Try this:
Sub date_add()
Dim i As Long
Dim dt As Worksheet
Set dt = ThisWorkbook.Worksheets("Date")
With dt
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For i = 1 To lastRow
.Cells(i, 2).Formula = "=DATE(J1,J2,C" & i & ")"
Next i
End With
End Sub
Where you input Year on J1, Month on J2 and the numbers of dates on column C
Part of the answer. Say cell A1 contains the value 2. Running this:
Sub eddie()
Dim i As Long, s As String
i = Range("A1").Value
s = "=DATE(20,20,20)"
Cells(i, 2).Formula = s
End Sub
will place the formula in cell B2
OK so here I go with my first question, advance apologies for any ambiguities.
I am working on a sheet where I pull data through SQL, and copy it to a certain table. The data contains string value. I am currently using vba to pull data (as there are variable involved), and copy it to grid how I want it.
The problem comes here; after I have copied the data, I have to merge certain Cells (sometimes two sometimes 3), and I do this manually. The condition is if C13 = C14 then merge, and if I merge C13 and C14 I have to merge B13 and B14 as well, and D13 and D14 as well. Next I want to check if the merged cell (which is now C13) is equal to C15, and then merge C13 to C15, and if this condition is true then B & D are also going to be merged.
If the condition of C13 is not true i.e. C13 <> C14 I want to go to next cell C14 and check if C14 = C15 or not.
I want to do this with vba, but trying to do this manually, will run into miles and miles of codes can someone please help?
This is the start of the code I have found here and managed to change a bit but now I am lost
Sub Merge()
Dim k As Range, cell As Range, name As String
Set k = Range("C13:C50")
For Each cell In k
If cell.Value =
End If
Next
End Sub
I could propose you the following code:
Sub Merge()
Dim k As Range, cell As Range, name As String
Set k = Range("C13:C50")
Application.DisplayAlerts = False
Do_it_again:
For Each cell In k
If cell.Value = cell.Offset(1, 0).Value _
And IsEmpty(cell) = False Then
Debug.Print cell.Address
'for column C
Range(cell, cell.Offset(1, 0)).Merge
'for column B
cell.Offset(0, -1).Resize(cell.MergeArea.Rows.Count, 1).Merge
'for column D
cell.Offset(0, 1).Resize(cell.MergeArea.Rows.Count, 1).Merge
GoTo Do_it_again
End If
Next
Application.DisplayAlerts = True
End Sub
I don't necessary like the code I proposed but after all it works as presented below.
Edit to improve efficiency
I have to admit that previous code wasn't efficient for big data table, like 5000 rows or more. One below is 90% faster but still need approx 10-20 sec for 5000 rows of data.
Most important changes compared to the code above are marked *****.
Sub Merge()
Dim k As Range, cell As Range, name As String
Dim kStart As Range, kEnd As Range '*****
Set kStart = Range("C13") '*****
Set kEnd = Range("C8000") '*****
Application.DisplayAlerts = False
Application.ScreenUpdating = False '*****
Do_it_again:
For Each cell In Range(kStart, kEnd) '*****
If cell.Value = cell.Offset(1, 0).Value _
And IsEmpty(cell) = False Then
Application.StatusBar = cell.Address '***** check progress in Excel status bar
'for column C
Range(cell, cell.Offset(1, 0)).Merge
'for column B
cell.Offset(0, -1).Resize(cell.MergeArea.Rows.Count, 1).Merge
'for column D
cell.Offset(0, 1).Resize(cell.MergeArea.Rows.Count, 1).Merge
Set kStart = cell '*****
GoTo Do_it_again
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True '*****
End Sub
Sorry, forgot to initialize count # 14
current = cells(13,3)
count = 14
for i = 14 to 15
next = cells(i,3)
If current = next then
'match encountered, merge columns B,C,D
for j = 2 to 4
cells(13,j) = cells(13,j) & cells(count,j)
next j
count = count + 1
end if
next i
If you are not trying to append but replace the value of C13 with C14 if matched, and C13 with C15 if matched etc..., then change the line
cells(13,j) = cells(13,j) & cells(count,j)
to
cells(13,j) = cells(count,j)
Basically I have the following scenareo:
2 columns, with 600 rows of data.
I need to copy the data from column 2 and place it at the end of the content in column1 for the same rows. This would result in column 1 having its original content plus the additional content of column 2.
Any information in how I can do this will be greatly appreciated.
Thanks in advance!
Here's a VBA in a simple form. Just create a macro, add these lines to it. Then select your original column (what you're calling column 1), and run the macro.
a = ActiveCell.Value
b = ActiveCell(1, 2).Value
ActiveCell.Value = a + b
The bracketed cell reference is a relative statement - 1, 2 means "same row, one column to the right" so you can change that if you need. You could make it loop by expanding thusly:
Do
a = ActiveCell.Value
b = ActiveCell(1, 2).Value
ActiveCell.Value = a + b
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
Exit Do
End If
Loop
That loop will carry on until it finds a blank cell, then it'll stop. So make sure you have a blank cell where you want to stop. You could also add extra characters into the line that combines.. so in the above example it's ActiveCell.Value = a + b, but you could make it ActiveCell.Value = a + " - " + b or anything else that may help.
This should take the values from column 2 and place them sequentially at the bottom of column 1.
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Dim cl As Range
Dim r As Long
Set rng1 = Range("A1", Range("A1048576").End(xlUp))
Set rng2 = Range("B1", Range("B1048576").End(xlUp))
r = rng1.Rows.Count + 1
For Each cl In rng2
Cells(r, 1).Value = cl.Value
r = r + 1
Next
End Sub
Just keep it simple. Here is the code.
Sub copyCol()
Dim lastRow As Long
lastRow = Range("A65000").End(xlUp).Row
Range("B1:B" & lasrow).Copy Range("A" & lastRow).Offset(1, 0)
End Sub
As this question received a number of views (10,000+) I thought it was important to also share another and far simpler solution:
In cell C1 use the formula:
=(A1 & B1)
This will copy the content of cell A1 and B1 into cell C1. Drag the formula to all other rows (row 600 in my case).
Then copy the column and paste using 'values only'.
You will then have cells in column C containing the content of column A and column B in a single cell on a row-to-row basis.
I want to run an excel vba which will go down column E and upon finding the value = "capa" will go two cell below, calculate the hex2dec value of that cell, present it by the cell with the value "capa" in column F and continue to search down column E.
So far I've came with the below but it doesn't work:
For Each cell In Range("E:E")
If cell.Value = "Capa" Then
ActiveCell.Offset.FormulaR1C1 = "=HEX2DEC(R[2]C[-1])"
End If
Next cell
Thanks!
How about something like this?
This will search volumn E for "Capa" and, if found, will place formula in column F using the value directly below "Capa" in column E
Sub CapaSearch()
Dim cl As Range
For Each cl In Range("E:E")
If cl.Value = "Capa" Then
cl.Offset(0, 1).Formula = "=HEX2DEC(" & cl.Offset(1, 0) & ")"
End If
Next cl
End Sub
You really want to limit the loop so you don't loop over the whole sheet (1,000,000+ rows in Excel 2007+)
Also, copying the source data to a variant array will speed things up too.
Try this
Sub Demo()
Dim dat As Variant
Dim i As Long
With ActiveSheet.UsedRange
dat = .Value
For i = 1 To UBound(dat, 1)
If dat(i, 6 - .Column) = "Capa" Then
.Cells(i, 7 - .Column).FormulaR1C1 = "=HEX2DEC(R[2]C[-1])"
End If
Next
End With
End Sub