I want a formula for column E3 depend on column A3,B3,C3 and D3. If multiple columns show yes or single column show yes I want show as below in pink. Need to combine shctin names which show "yes".Formula required for column E .End result shoul show as pink color.
Check it out
Sub Button1_Click()
Dim x, y, z
For x = 3 To 15
For y = 1 To 4
If UCase(Cells(x, y)) = "YES" Then
z = z & "_" & Cells(2, y)
End If
Next y
Cells(x, 5) = Right(z, Len(z) - 1)
z = ""
Next x
End Sub
User Defined Function,the function code belongs in a regular module.
Place this formula in E3 and drag down,
=Get_It(A3:D3,2)
Function Get_It(a As Range, Return_Row As String)
Dim c As Range
Dim s As String
For Each c In a.Cells
If UCase(c) = "YES" Then
s = s & "_" & Cells(Return_Row, c.Column)
End If
Next c
Get_It = Right(s, Len(s) - 1)
End Function
There's another way using formulas. A little ugly but ok as a non-VBA alternative.
Related
I have the following code that I assume has several issues. I need it to input different values in two cells based off of a CheckBox.
Sub YesNoChkBox()
Dim ChkBx As CheckBox, g As Integer, h As Integer, r As Integer
Set ChkBx = ActiveSheet.CheckBoxes(Application.Caller)
With ChkBx.TopLeftCell
r = .Row
g = .Column + 2
h = .Column + 3
End With
If ChkBx = 1 Then
gr = "NO"
hr = "NO"
Else
gr = "YES"
hr = ""
End If
End Sub
I need the checkbox to input NO, NO into the two cells (2 and 3 columns over) if checked, and YES, BLANK ("") if unchecked respectively.
The reason I am using r,g,h is because I would like to just copy and paste the checkbox to different rows and have it automatically populate the corresponding cell (which will always be column G:H but rows 5:21)
Do you mean this?
If ChkBx = 1 Then
Cells(r, g) = "NO"
Cells(r, h) = "NO"
Else
Cells(r, g) = "YES"
Cells(r, h) = ""
End If
Example
A B C D
1
2 15 16
3
VBA loop macro found value in cell C2 so it add this value to the value in the same row Cell A2 thus making the value of Cell A2 31 and clears the value from Cell C2
Dim y, x, search as Integer
Dim searchRadius as Integer 'Radius of Cells you want to search in (e.g. 100x100)
search = TextBox1.Value 'set search to something
y = 1
x = 2
For y = 1 To searchRadius
If Cells(y, x) = search Then
Cells(y, 1).Value = Cells(y, 1).Value + search
Cells(y, x).Select
Cells(y, x) = ""
End If
If y = searchRadius and x <= searchRadius Then
x = x + 1
y = 0
End If
Next y
Does this work for you?
I have an Excel document with some plain text in a row. The cells in the range A1:A5 contain texts, then a hundred of rows down there's another few rows with text. Cells between are empty.
I've set up a Do Until loop which is supposed to copy cells with text, and then stop when an empty cell appears. My loop counts and copies 136 cells including the 5 with text.
So my question is why?
The bottom line: Hello ends up on line 136, and then there's a huge gap of empty cells until next area with text. Do the 131 white cells contain any hidden formatting causing this?
I've tried "Clear Formats" and "Clear All". I've also tried using vbNullString instead of " ".
Code snippet:
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Integer, y As Integer
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
Do Until assets.Worksheets(1).Range("A" & x) = ""
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
x = x + 1
y = y + 1
Loop
test.Worksheets(1).Range("A" & x).Value = "Hello"
End Sub
Use a For Next Statement terminating in the last used cell in column A. Only increment y if there has been a value found and transferred and let the For ... Next increment x.
Sub CopyTags_Click()
Dim assets As Workbook, test As Workbook
Dim x As Long, y As Long
Set assets = Workbooks.Open("file-path.xlsx")
Set test = Workbooks.Open("File-path.xlsx")
x = 1
y = 1
with assets.Worksheets(1)
for x = 1 to .cells(rows.count, 1).end(xlup).row
if cbool(len(.Range("A" & x).value2)) then
test.Worksheets(1).Range("A" & y) = assets.Worksheets(1).Range("A" & x)
y = y + 1
end if
next x
test.Worksheets(1).Range("A" & y).Value = "Hello"
end with
End Sub
I am struggling to write an effective macro that will find a cell with error in column, then replace that cell with value of the first non-empty cell without error below it (there might be consecutive error cells) then loop for 12 columns.
The code I have below replaces each of the error cells in all 12 columns, but not in a consistent manner: some cells will indeed be filled by the next cell below that contains a number, but some cells end up with value of the second next cell below that contains a number. I can't tell where the problem in my code is.
Option Explicit
Sub ClearError()
ThisWorkbook.Sheets("WorkSheet1").Activate
Dim c, x, z As Integer
Dim y As Long
For z = 3 To 14 Step 1 ' Start with column 'C' and do for total of 12 columns
x = 999
For c = 1 To x Step 1
If IsError(Cells(c, z)) Then
Cells(c, z) = Range(Cells(1, z), Cells(x, z)).Find(y, _
After:=Cells(c, z), LookIn:=xlValues, SearchDirection:=xlNext).Value
End If
Next c
Next z
End Sub
If you could offer any insight or advice, I would greatly appreciate it. Thank you for your time! Ante
Try reversing your loop.
For c = x to 1 Step -1
If IsError(Cells(c, z)) Then
Cells(c, z) = Cells(c + 1, z)
End If
Next c
For a project I'm looking to compare Col.A and Col.A. I've added the numbers using code but cant work out how to compare the two in Col. C for example if Col.A and Col B match I want Col.C to say "yes" or "No". also if I wanted to do this with Codes and not numbers would I add just string and not int? Or what if I wanted to match dates. Any help be great as I'm just getting back into VB
The code I've worked on is below
Private Sub CommandButton1_Click()
Cells.ClearContents
Range("A1") = "Column A"
Range("B1") = "Column B"
Range("C1") = "Column C"
Dim i As Boolean
For i = 2 To 25
Range("A" & i) = Int((10 - 2 + 1) * Rnd + 2)
If i < 26 Then
Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = _
Int((10 - 2 + 1) * Rnd + 2)
End If
Next i
End Sub
Can you use Excel's built in exact function?
FormulaR1C1 = "=EXACT(RC[-2],RC[-1])"
The function will return a value of TRUE or FALSE
Before the snippet FormulaR1C1 you'll want to input the destination cell for the formula
The RC[-2],[RC-1] says perform the "EXACT" calculation on the cells: 1 cell to the left and 2 cells to the left