Ok, so I have 10 columns, labelled "A"-"J".
Each Row will have some combination of these columns filled in with string values.
I need to run some conditional statements and I'm wondering if there is a more efficient method of doing them without simply looping through them all.
What I have now:
If isempty("A1) then
Else
if isempty("B1") then
else
Sheet2!"B1" = "A1 and B1"
end if
if isempty("C1") then
else
Sheet2!"A1" = "A1 and C1"
end if
[...etc]
end if
If isempty("B1) then
Else
if isempty("C1") then
else
Sheet2!"B1" = "B1 and C1"
end if
if isempty("D1") then
else
Sheet2!"C1" = "C1 and D1"
end if
[...etc]
end if
It's long, cumbersome, and not very pretty. Moreover, it takes a long time because we have a few hundred records (rows) to go through. Is there a faster way to look at X Row, say A,B,C,E,&J have things, and do stuff based on that.
If A,C,&J are filled Do this..
If B is empty do this...
If C Or D is full, do this other thing.
I'm not entirely sure of the order in which cells should be checked but perhaps this will get you started.
Dim rw As Long, lr As Long
With Cells(1, 1).CurrentRegion
lr = .Rows.Count
For rw = 1 To lr
If Application.CountA(Range("A" & rw & ",C" & rw & ",J" & rw)) = 3 Then
'If A,C,&J are filled Do this..
ElseIf IsEmpty(Range("B" & rw)) Then
'If B is empty do this...
ElseIf CBool(Application.CountA(Range("C" & rw & ",D" & rw))) Then
'If C Or D is full, do this other thing.
End If
Next rw
End With
Related
I'm trying to make a function to do the following:
Cycle through all my datasets in my sheet
Cycle through each column in my datasets
Look at the title for that column and check if it is in my list.
Find find a few various other columns, but this time using .Find
Now cycle through each row in the column for that specific dataset
Use the column references found in point 4 and the row from point 5 to put the cell's into a variable that will be used on step 7 which is to insert a formatted comment in the originally found column (for that row).
I've tried getting some code working from what I found on a different site but I can't get it working correct, I'm stuck at part 5.
A data example could look like:
My attempted code looks like:
Sub ComTest()
COMLIST = ";Cond;"
Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each a In rng.SpecialCells(xlCellTypeConstants).Areas
With a.CurrentRegion
Set r = .Rows(1)
For j = 1 To r.Columns.Count
TitleCell = r.Cells(j).Address
v = ";" & Range(TitleCell).Value & ";"
'-----------------------------------------------------------------------------------------
If InStr(1, COMLIST, v) Then
On Error Resume Next
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Condw = r.Columns.Find(Replace(v, ";", "") & " " & "w", lookAt:=xlWhole).Column
Condw = .Cells(r, Condw).Address
' Add more stuff here
End If
'-----------------------------------------------------------------------------------------
Next j
End With
Next a
End Sub
As for part 7, the output would essentially be as follows for "row 1" but this part I should be able to do, it's the looping part that I am struggling with.
This question raises a few points that this answer might resolve for you and others in the future:
I note that not many of your previous questions have accepted answers, and that several of them present answers but you have needed to respond by saying it doesn't suit your needs for a certain reason. It suggests you aren't really providing the right details in your question. I think that's the case here. Perhaps you could outline the outcome you are trying to achieve and, especially for Excel VBA, the precise structure of your spreadsheet data. It's tempting to think in this question that you simply want to know how to take the values of Columns C to F and write them to a comment in Column B for any row that contains data.
Using web code can often take more time to understand and adapt than learning the code syntax from first principles. Your provided code is difficult to follow and some parts seem odd. I wonder, for example, what this snippet is meant to do:
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Using Option Explicit at the top of your module (which forces you to declare your variables) makes VBA coding and debugging much easier, and code submitted on SO is easier to follow if we can see what data types you meant variables to hold.
If your question is merely "How do I take the values of Columns C to F and write them to the cell in Column B for any row that contains data?", then your code could be as simple as:
Dim condCol As Range
Dim cell As Range
Dim line1 As String
Dim line2 As String
Dim cmt As Comment
'Define the "Cond" column range
'Note: this is an unreliable method but we'll use it here for the sake of brevity
Set condCol = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns("B")
'Delete any comment boxes
condCol.ClearComments
'Loop through the cells in the column and process the data if it's a number
For Each cell In condCol.Rows
If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
'Acquire the comment data
line1 = "Cond: " & cell.Offset(, 1).Value & "/" & cell.Offset(, 2).Value & _
" (" & Format(cell.Offset(, 3), "0.00%") & ")"
line2 = "Cond pl: $" & cell.Offset(, 4).Value
Set cmt = cell.AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
End If
Next
If, on the other hand, your question is that you have unreliable data on your spreadsheet and your only certainty is that the headings exist on any one row, then some form of search routine must be added. In that case your code could look like this:
Dim rng As Range
Dim rowRng As Range
Dim cell As Range
Dim condCol(0 To 4) As Long
Dim line1 As String
Dim line2 As String
Dim allHdgsFound As Boolean
Dim i As Integer
Dim cmt As Comment
Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange
rng.ClearComments
For Each rowRng In rng.Rows
If Not allHdgsFound Then
'If we haven't found the headings,
'loop through the row cells to try and find them
For Each cell In rowRng.Cells
Select Case cell.Value
Case Is = "Cond": condCol(0) = cell.Column
Case Is = "Cond w": condCol(1) = cell.Column
Case Is = "Cond r": condCol(2) = cell.Column
Case Is = "Cond %": condCol(3) = cell.Column
Case Is = "Cond wpl": condCol(4) = cell.Column
End Select
Next
'Check if we have all the headings
'by verifying the condCol array has no 0s
allHdgsFound = True
For i = 0 To 4
If condCol(i) = 0 Then
allHdgsFound = False
Exit For
End If
Next
Else
If Not IsEmpty(rowRng.Cells(1).Value) Then
'The cell has values so populate the comment strings
line1 = "Cond: " & rowRng.Columns(condCol(1)).Value & "/" & _
rowRng.Columns(condCol(2)).Value & _
" (" & Format(rowRng.Columns(condCol(3)).Value, "0.00%") & ")"
line2 = "Cond pl: $" & rowRng.Columns(condCol(4))
Set cmt = rowRng.Columns(condCol(0)).AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
Else
'We've reached a blank cell so re-set the found values
allHdgsFound = False
Erase condCol
End If
End If
Next
Of course your data might be structured in any number of other ways, but we don't know that. My point is that if you can be more specific in your question and provide an outcome you are trying to achieve, you are likely to receive answers that are more useful to you.
I'm very new to macros (it's been a few days now!) but slowly working my way through. I'd like to create a macro that adds a value of 2 to a cell if column D contains the text "(2)" AND column AG contains the text "Adult".
I've created a macro that so far changes the value of the cell to 5 (instead of adding to it) if column D contains the text "(2)" - I've spent a while messing around with "And" functions but I can't seem to find a way to make it take into account the both the "(2)" text in the D column and the "Adult" text in the AG column (I can only make it search one or the other).
Here's my attempt (this doesn't include any of my failed attempts to include the "Adult" text):
Sub BUBFindGuests()
Dim SrchRng As Range
lastRow = Range("D" & Rows.Count).End(xlUp).Row
Set SrchRng = Range("D1:D" & lastRow, "AG1:AG" & lastRow)
For Each cel In SrchRng
If InStr(1, cel.Value, "(2)") > 0 Then
With cel.Offset(0, 39)
.Offset(-1, 0) = "5"
End With
End If
Next cel
End Sub
I'm basically just trying to work out how to include the "Adult" text from the AG column, and also how to make the macro add rather than change the end value. I'm also relatively certain that some parts of my code are unnecessary or clunky, but with my level of experience I'm unsure of how to correct that. Any help would be much appreciated.
Judging by your code, you want to add 2 to column C, if that's the case this should do the trick:
Sub BUBFindGuests()
lastRow = Sheets("SHEETNAME").Range("D" & Rows.Count).End(xlUp).Row
For x = 1 to lastRow
If InStr(1, Sheets("SHEETNAME").Cells(x, 4), "(2)") <> 0 _ 'Checks column D
And Instr(1, Sheets("SHEETNAME").Cells(x, 33), "Adult") <> 0 Then 'Checks column AG
Sheets("SHEETNAME").Cells(x, 3).Value = _
Sheets("SHEETNAME").Cells(x, 3).Value + 2 'Change 3 to the appropriate column
End If
Next x
End Sub
You can search for Adult just as you searched for the (2). Just use the InStr-function two times and combine the result-booleans. You can do that in two ways, logical with And or nested with two if-statements:
If InStrResult1 **And** InStrResult2 Then 'do stuff End If
If InStrResult1 Then If InStrResult2 Then 'do stuff End If End If
Sorry for the bad formation.
You can then store the current value of your cell in a variable. Then add 2 to that variable (myVariable = myVariable + 2) and then set its value to your cell instead of 5.
EDIT: It turns out I misread your question. See revised code.
Sub BUBFindGuests()
Dim SrchRng As Range
lastRow = Range("D" & Rows.Count).End(xlUp).Row
Set SrchRng = Range("D1:D" & lastRow, "AG1:AG" & lastRow)
For Each cel In SrchRng
If InStr(1, cel.Value, "(2)") > 0 And InStr(1, cel.Value, "Adult") > 0 Then cel.Offset(-1, 39).Value = .Offset(-1, 0).Value & "5"
Next cel
End Sub
I'm quite massively out of my depth here having never used vba before (My main role is primarily sql based), i'd like to sit down and spend a few days actually learing how all this works but i don't have days right now, hence throwing myself on your mercy!
Sub updateduration()
If Worksheets("Sheet1").Range("I4").Value = "Y" Then
Worksheets("Sheet1").Range("H4").Interior.ColorIndex = 43
Else
If Worksheets("Sheet1").Range("J4").Value = 1 Then
Worksheets("Sheet1").Range("H4").Interior.ColorIndex = 3
Else
If Worksheets("Sheet1").Range("J4").Value = 0 Then
Worksheets("Sheet1").Range("H4").Interior.ColorIndex = 45
End If
End If
End If
End Sub
As ugly as that probably is it works, Im now trying to adapt it so it adjusts all the cells in range H4:H34 one by one checking each if statement against the equivelant cell (i.e. range I4:I34 and range J4:34)
I've been looking at 'for each' to form an initial loop but am struggling to figure out how to specify which cells in the other ranges to look at in each iteration of the loop.
Any help or advice appreciated
L
Welcome to SE, L! You're off to a good start, and you're right that a FOR..NEXT loop is what you're looking for. The trick is to edit your Range with a variable, like this:
Sub updateduration()
Dim startRow As Integer, endRow As Integer
startRow = 4 'first row to compare/update
endRow = 34 'last row to compare/update
For myRow = startRow To endRow
If Worksheets("Sheet1").Range("I" & myRow).Value = "Y" Then
Worksheets("Sheet1").Range("H" & myRow).Interior.ColorIndex = 43
Else
If Worksheets("Sheet1").Range("J" & myRow).Value = 1 Then
Worksheets("Sheet1").Range("H" & myRow).Interior.ColorIndex = 3
Else
If Worksheets("Sheet1").Range("J" & myRow).Value = 0 Then
Worksheets("Sheet1").Range("H" & myRow).Interior.ColorIndex = 45
End If
End If
End If
Next myRow
End Sub
I have a sheet with multiple data in 1 cell this happen in a couple of columns. What I need to do is split the cell into individual rows while still keep the details from the other columns
Screen 1 shows the data i got
http://imageshack.com/a/img845/1783/wxc8.png (Screen 1)
Screen 2 is what i wish the macro to output.
http://imageshack.com/a/img842/7356/7yra.png (screen 2)
The macro i found and edited in only allows me to split 1 column and i can't get the editing of the range right. the columns that needs to be split is "J" "K" "N" and "O". The columns "A"- "I" and "L""M" just needs to copy their content to the new row.
Thank you in advance for the help.
Here the Macro im using
Sub Splt1()
Dim LR As Long, i As Long
Dim X As Variant
Application.ScreenUpdating = False
LR = Range("J" & Rows.Count).End(xlUp).Row
Columns("J").Insert
For i = LR To 1 Step -1
With Range("K" & i)
If InStr(.Value, Chr(10)) = 0 Then
.Offset(, -1).Value = .Value
Else
X = Split(.Value, Chr(10))
.Offset(1).Resize(UBound(X)).EntireRow.Insert
.Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End If
End With
Next i
Columns("K").Delete
LR = Range("J" & Rows.Count).End(xlUp).Row
With Range("L1:M" & LR)
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
On Error GoTo 0
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub
The problem appears to be the with operator. It constrains your selection. Try reformulating your macro without the with and refer to the the ranges direct. For example, replace your first for loop with something like this:
For i = LR To 1 Step -1
If InStr(Range("K" & i).Value, Chr(10)) = 0 Then
Range("K" & i).Offset(, -1).Value = Range("K" & i).Value
'Range("J" ...
'Range("N" ...
'Range("O" ...
Else
K_collection = Split(Range("K" & i).Value, Chr(10))
Range("K" & i).Offset(1).Resize(UBound(K_collection)).EntireRow.Insert
Range("K" & i).Offset(, -1).Resize(UBound(K_collection) - LBound(K_collection) + 1).Value = Application.Transpose(K_collection)
'J_collection = Split(Range("J"...
'N_collection = Split(Range("N"...
'O_collection = Split(Range("O"...
End If
Next i
In general I avoid with because it tends to obscure the visual pattern of code.
You might also consider eliminating the .INSERT and .DELETE columns, and overwrite directly to the cells. When working with more than one at a time, it becomes hard to keep track which column is temporary and which one is the source. But that all depends on your preference.
Copying values for the other columns should be easy compared to this.
I need help with my code, I'm not sure why it isnt running properly and takes a very long time. What i'm trying to do is to locate repeated temp, for example, 0. After locating 0, I will continue to look for any more 0 at the temp row, if there is i will sum the test1 of B3 and test1 of H3 together... it will continue until the end of the row and will be pasted at Column N or O which is an empty column. After that, will have to do the same for 100, overall.
The resultant should be like this
I have trouble running the following code that i tried writing.
Dim temprow As Long, ColMax1 As Long, tempcell As Range, ColCount1 As Long
Dim temprow1 As Long, valuetohighlight As Variant, valuetohighlight1 As Variant
Dim totalvalue As Double, findvalues As Long
temprow = 1
ColMax1 = 10
Do
Set tempcell = Sheets("Sheet1").Cells(temprow, 1)
'Look for the word temp in column A
If tempcell = "temp" Then
'Look for values = 0
For ColCount1 = 2 To ColMax1
findvalues = Sheets("Sheet1").Cells(temprow, ColCount1)
If findvalues = 0 Then
temprow1 = temprow + 1
valuetohighlight = Sheets("Sheet1").Cells(temprow1, ColCount1)
End If
Next
'Look for other values that is equal to 0
For ColCount1 = 3 To ColMax1
findvalues = Sheets("Sheet1").Cells(temprow, ColCount1)
If findvalues = 0 Then
temprow1 = temprow + 1
valuetohighlight1 = Sheets("Sheet1").Cells(temprow1, ColCount1)
End If
Next
temprow = temprow + 1
End If
Loop
For ColCount1 = 1 To ColMax1
If Sheets("Sheet1").Cells(temprow, ColCount1) = "" Then
totalvalue = 0
totalvalue = valuetohighlight + valuetohighlight1
End If
Next
End Sub
If you have any ideas or opinion, do share it with me.. will appreciate your help!
Slight Modifications
Now need also to consider the name.
What you want to achieve can be done with a formula. The trick is to keep the Cell Headers in Col O to Q in Row 2 to actual values that you want to compare.
Formula in Cell O3
=SUMPRODUCT(($B$2:$M$2=$O$2)*B3:M3)
Snapshot
FOLLOW UP
Hi, i remember u using that formula and typed it into a VBA for me before, i have tried and it work.. Sheets("Sheet1").[O5] = Evaluate("SUMPRODUCT((B2:M2=O2)*(B5:M5))") but, i cant really have a fixed column for the printed result and also the temp may not falls on Row 2...
Here is a sample code. Change 15 to the relevant column where you want to display the result. I have commented the code so you shouldn't have any problem in understanding the code. If you still do then simply ask :)
CODE
Option Explicit
Sub Sample()
Dim ColNo As Long, tempRow As Long
Dim ws As Worksheet
Dim aCell As Range
'~~> Change this to the column number where you want to display the result
'~~> The code assumes that Row 2 in this column has headers
'~~> for which you want to retrieve values
ColNo = 18 '<~~ Example :- Column R
'~~> Change this to relevant sheet name
Set ws = Sheets("Sheet1")
'~~> Get the row number which has "Temp"
Set aCell = ws.Columns(1).Find(What:="Temp", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'~~> This is the row which has 'Temp'
tempRow = aCell.Row
'~~> Sample for putting the value in Row 3 (assuming that 'temp' is not in row 3)
'~~> SNAPSHOT 1
ws.Cells(3, ColNo).Value = Evaluate("=SUMPRODUCT(($B$" & tempRow & ":$M$" & tempRow & "=" & _
ws.Cells(2, ColNo).Address & ")*(B3:M3))")
'~~> If you want to use formula in the cell in lieu of values then uncomment the below
'~~> SNAPSHOT 2
'ws.Cells(3, ColNo).Formula = "=SUMPRODUCT(($B$" & tempRow & ":$M$" & tempRow & "=" & _
ws.Cells(2, ColNo).Address & ")*(B3:M3))"
Else
MsgBox "Temp Not Found. Exiting sub"
End If
End Sub
SNAPSHOT (IF YOU USE EVALUATE IN THE ABOVE CODE)
SNAPSHOT (IF YOU USE .FORMULA IN THE ABOVE CODE)
HTH
Sid