thank you for the help in advance!
I am creating a macro that writes to a text file. I am having trouble referencing a range inside of a for loop. There are two examples I have where the range I have called returns a "". For the first image below, this is where the user inputs data using a combination of entering data into the sheet and using a button that directs them to a user form that plops in what they entered. In this first image, where the user is directed by the userform, the data is outputted to another sheet and I use vlookup to display the info. I do this to run operations on the other sheet and just to help me keep track of everything, (novice vba user). The second sheet is where data is stored and calculations are run.
1st image, User input and display 2nd image, data storage and calculation sheet
newDimName only outputs "_Cav" and the value stored in cavNum for the loop. The intention is concatenate the string inside of column A with more information depending on what the user has inputted. I suspect I am not referencing the range for column a correctly. The Loop is set to go to 2 to whatever amount of "dimensions" have been entered by the user (value in lastUserDim). The code below is contained with a sheet reference (not in the snippet) so it references the correct sheet. Ex. "With Sheet2", at before the loop and a "End With" at the end of the loop.
Dim a As Integer, cavNum As Integer
Select Case numCav
Case Is = 4
For a = 2 To lastUserDim
For cavNum = 1 To 4
newDimName = Cells(a, 1) & "_Cav" & cavNum
Next cavNum
Next a
totalColumns = 4 * lastUserDim
Case Is = 8
For a = 2 To lastUserDim
For cavNum = 1 To 8
newDimName = Cells(a, 1) & "_Cav" & cavNum
Next cavNum
Next a
totalColumns = 8 * lastUserDim
Case Is = 16
For a = 2 To lastUserDim
For cavNum = 1 To 16
newDimName = Cells(a, 1) & "_Cav" & cavNum
Next cavNum
Next a
totalColumns = 16 * lastUserDim
Case Is = 32
For a = 2 To lastUserDim
For cavNum = 1 To 32
newDimName = Cells(a, 1) & "_Cav" & cavNum
Next cavNum
Next a
totalColumns = 32 * lastUserDim
Case Else
MsgBox "Please select what # of cavities this tool has."
End Select
For the code below, I want the the range I defined to be read and for the select case to determine if a cell contains yes or no. The loop is intended to run this operation for number of user inputted data. Again I suspect I am not calling the data in column c correctly like I was previously with Column A. I tried using cells like in the first code snippet, just range, range("").value, and range("").text.
Dim LSLBound As String, LSLBoundRef As String
Dim c As Integer
For c = 2 To lastUserDim
LSLBoundRef = Range("C2:C" & c).Text 'ref to cell value to use for select case
Select Case LSLBoundRef
Case Is = "No"
LSLBound = "LBound 1;"
Case Is = "Yes"
'Do Nothing
End Select
Next c
If the second code snippet is wrapped in a "With Sheet2", you need to preface the Range with a period, ie **.**Range("C2")... so that it is using the correct sheet.
Dim LSLBound As String, LSLBoundRef As String
Dim c As Integer
With Sheets("Sheet2")
For c = 2 To lastUserDim
LSLBoundRef = .Range("C2:C" & c).Text 'ref to cell value to use for select case
Select Case LSLBoundRef
Case Is = "No"
LSLBound = "LBound 1;"
Case Is = "Yes"
'Do Nothing
End Select
Next c
End With
A good way to figure out what range is actually being referenced is by printing the range address to the immediate window with Debug.Print Range.Address.
Related
So, I haven't figured out how to do this.
Basically, I want something like this:
P1 P2 P3 TOTAL SCORE
-- -- -- P1 P2 P3
21 / 13 1 2 0
/ 17 10
6 7 /
So, the three columns must compare to one-another (the "/" means that the player didn't play that game, but it doesn't have to be printed), the greatest among the three gets a +1 value in the TOTAL SCORE tab.
Plus, is there any easier way to do this than comparing one cell to another cell? I mean, is there a possibility to drag and mark all cells on all of the three columns and make sure that they only compare the cells in the three columns IN THE SAME ROW?
Let us assume that the data appears as in the picture in Sheet1 (Don't change the structure):
Open an Excel
Press ALT & F11 to open Visual Editor
Add a module from > Insert (in the Upper toolbar) - Module ( third option)
Paste the below codes & execute Sub Evaluation() (press F5 when your cursor is in Sub Evaluation)
To store lastrow in order to continue from the next record i use sheet2 range A1
Try:
Option Explicit
Public Sub Process_Data(ByVal I_Value As Long)
Dim LastRow As Long
Dim i As Long
Dim CA As Integer
Dim CB As Integer
Dim CC As Integer
With Sheet1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = I_Value To LastRow '<= Lets say that the first score is at sheet1 column A row 3.LastRow represent the row of the last data in column A
CA = 0
CB = 0 '<= Every time that i change value we zero our variables to get the new value
CC = 0
If .Range("A" & i).Value = "/" Then '<= Check if there is a number or "/".if there is "/" we zero variable
CA = 0
Else
CA = .Range("A" & i).Value
End If
If .Range("B" & i).Value = "/" Then
CB = 0
Else
CB = .Range("B" & i).Value
End If
If .Range("C" & i).Value = "/" Then
CC = 0
Else
CC = .Range("C" & i).Value
End If
If CA > CB And CA > CC Then ' <= Check which number is bigger
.Range("E3").Value = .Range("E3").Value + 1 '<= At one point to each category
ElseIf CB > CA And CB > CC Then
.Range("F3").Value = .Range("F3").Value + 1
ElseIf CC > CA And CC > CB Then
.Range("G3").Value = .Range("G3").Value + 1
End If
Next i
End With
End Sub
Sub Evaluation()
Dim Value As Long
Dim LastRow As Long
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
If (LastRow = 2) Or (LastRow = Sheet2.Range("A1").Value) Then '<= Check if the table has new data
Exit Sub
Else
If Sheet2.Range("A1").Value = "" Then '<=Check which value will adopt be i
Value = 3
Else
Value = Sheet2.Range("A1").Value + 1
End If
End If
Call Process_Data(I_Value:=Value)
Sheet2.Range("A1").Value = Sheet1.Range("A" & Rows.Count).End(xlUp).Row '<= Record the lastrow processed out
End Sub
Use the LARGE function to find the highest number for the individual games on the left. Then use an IF statement out to the right to check if the value of the LARGE function matches the player's game score. If it does match (TRUE), assign a value of 1. If it doesn't match (FALSE), assign a value of 0. Then SUM each player's modifiers that you've assigned with the IF function.
If ties are possible in the individual game scores, you'll also need to nest another IF function to handle that possibility.
I have a code that searches an excel fill for the word distance, takes the value of the cell next to it, paste it into a new cell, then sums all the cells up. Which works great, but i now need to find a way to only sum ever even row number. Does that make sense?
Sub Distance_Check()
Dim DistanceCheck As String
Dim DistanceNumber As String
Dim DistanceSum As String
Dim DistanceTotal As String
DistanceCheck = MsgBox("Would you like to check the distance?", vbYesNo)
If DistanceCheck = vbYes Then
If IsArray(fname) Then Workbooks.OpenText fname(1)
i = 1
findStr = "Distance"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("J" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
Set wkbSourceBook = ActiveWorkbook
DistanceNumber = i - 2
DistanceSum = WorksheetFunction.Sum(Range(Cells(2, 15), (Cells(DistanceNumber + 1, 15))))
DistanceTotal = DistanceSum / DistanceNumber
If DistanceNumber = Cells(2, 12) Then
MsgBox ("No error found wihin distance")
Else
MsgBox ("Error found with distance")
End If
Else
End If
Call Save_Data
End Sub
Would the way youd go about this be using a for loop on the
cells(DistanceNumber(j,+1)
Where j = 0,
j = j +2 ,
Until j > DistanceNumber,
Would that work? If so how would you go about it?
Thanks
A quick way to step through a loop in the desired increments is to use the Mod operator which divides two numbers and returns any remainder (e.g. 7 mod 2 = 1, as two sixes fit into seven, leaving one).
You can use the row property of the range you identify with the Find method, and since you want to jump by two the modulo should be zero:
If foundcel.Row Mod 2 = 0 Then Range("J" & i).value = foundcel.Offset(0, 1).Value
That said, there is a 'built in' way to step through a loop if using a For loop like this
For x = 2 to 10 Step 2
' Do stuff
Next x
You can also use this method to step backwards, e.g.
For x = 100 to 0 Step -10
' Do stuff backwards!
Next x
Can you guys help me out? I think i'm kind of stuck with the code below. I almost got the code that I wanted but at the end it does not do the thing I like.
Dim acs, cos, as_col, as_row As Integer
cos = Sheets.Count
acs = ActiveSheet.Index
as_LRow = Sheets(acs).Cells(Sheets(acs).Rows.Count, "A").End(xlUp).Row
For as_row = 3 To as_LRow
std_number = Sheets(acs).Cells(as_row, 1).Value
earliersheets = acs - 1
For s = 1 To earliersheets
ilast_row = Sheets(s).Cells(Sheets(s).Rows.Count, "A").End(xlUp).Row
For r = 3 To ilast_row
std_number_new = Sheets(s).Cells(r, 1).Value
If std_number = std_number_new Then
a = a & Sheets(s).Cells(r, 6).Value
'Sheets(acs).Cells(as_row, 8).Value = Sheets(s).Cells(r, 8).Value
Sheets(acs).Cells(as_row, 8).Value = Sheets(acs).Cells(as_row, 6).Value & " + " & a
End If
a = ""
Next r
Next s
Next as_row
What I want is:
After adding, manually, a new sheet I want to press on a button. This button activates the code above. What I want is to check a value in a particulaire cell in column "A". If the value in this column matches with the value from previous sheet then display the value in the sixth column in the newly added sheet. The code above does that, but it works only for two sheets. If I make more then two sheets it does not display more values then two.
Update
I added my file in the link: Check.xlsm
After opening this file clear the H-column in the third (and maybe the second sheet) then run the macro within. You'll see what I mean
All I want is to get all the previous values in previous sheet displaced in column-H. For example I marked two cells with values, these values get displayed in the H-column after running the macro.
Your problem was that you were always storing in column H a value created by taking the value from column F of the current sheet and appending the value from column F of the sheet being processed within the loop. When you move to the next sheet within the loop, you're replacing the previous value with a new value.
So, when processing sheet w3-6, you first look at sheet w1-4 and generate a value of "13 + 34" and store that in sheet w3-6's cell H3. Then you look at sheet w2-5 and generate a value of "13 + 18" and replace the value of "13 + 34" currently in sheet w3-6's cell H3 with the value of "13 + 18".
Try this code instead:
Dim acs As Long, cos As Long, as_col As Long, as_row As Long
Dim s As Long
Dim as_LRow As Long
Dim ilast_row As Long
Dim r As Long
Dim a As String
cos = Sheets.Count
acs = ActiveSheet.Index
as_LRow = Sheets(acs).Cells(Sheets(acs).Rows.Count, "A").End(xlUp).Row
For as_row = 3 To as_LRow
std_number = Sheets(acs).Cells(as_row, 1).Value
'Initialise variable containing result to go into column H
a = Sheets(acs).Cells(as_row, 6).Value
'Process earlier sheets in reverse order
'(so that values will be shown in reverse order)
For s = acs - 1 To 1 Step -1
ilast_row = Sheets(s).Cells(Sheets(s).Rows.Count, "A").End(xlUp).Row
For r = 3 To ilast_row
std_number_new = Sheets(s).Cells(r, 1).Value
If std_number = std_number_new Then
'Append value to result string
a = a & " + " & Cstr(Sheets(s).Cells(r, 6).Value)
Exit For
End If
Next r
Next s
'Store result
Sheets(acs).Cells(as_row, 8).Value = a
Next as_row
I have a table where user can insert multiple rows over multiple columns where some data is string and some numeric. I want to create a button such that when the user clicks it, it will create a new table on the same excel sheet but with some of the rows combined based on predefined condition.
Eg. The table "pre defined condition" states that alpha and gamma are similar and so on(it can many rows like this which show the conditions to combine rows..condition will always pertain to second row of the user defined table i.e table 1)...Table 1 will be created by a different user and he can enter as many rows as he wishes to. So using these 2 tables (Table 1 & Pre defined condition tabel) I want to create a new table which has certain rows combined with stringfrom two rows separated using "/" and numbers added.
The structure will remain the same for all tables.
Edit:One value in column 2 will always have same value in column 1.Basically column 2 is a dependent list(on column 1 ). There can be many pre -defined conditions and not just limited to 2 . Usually there won't be any duplicate values in column 2,but in case there are I want to combine them in a row at click of the button.
Table 1
A Alpha 100 1
B Beta 200 2
C Gamma 300 3
D Kappa 400 4
Pre Defined Condition
Alpha Gamma
Beta Kappa
Desired Output
A/C Alpha/Gamma 400 4
B/D Beta/Kappa 600 6
Assuming that your data starts in A2:D2 (A1:D1 left for titles), that you state two conditions (for example Alpha Gamma) in columns F and G (starting in the second row; first row left for titles), that there is a command button, and that the worksheet is named "Sheet1", the following code should do the trick.
Dim i As Integer
Dim j As Integer
Dim lLastRowPDC As Integer
Dim lLastRowData As Integer
Dim sConditions As String
Dim sOrigin As String
Dim sColumnA As String
Dim sColumnB As String
Dim iColumnC As Integer
Dim iColumnD As Integer
Private Sub CommandButton1_Click()
lLastRowPDC = Worksheets("Sheet1").Cells(2, 6).End(xlDown).Row 'Rows with Conditions, starting in the second row
lLastRowData = Worksheets("Sheet1").Cells(2, 1).End(xlDown).Row 'Rows with data, starting in the second row
For i = 2 To lLastRowPDC
sConditions = Worksheets("Sheet1").Cells(i, 6).Value & Worksheets("Sheet1").Cells(i, 7).Value 'create a string with the two conditions
sColumnA = ""
sColumnB = ""
iColumnC = 0
iColumnD = 0
For j = 2 To lLastRowData
sOrigin = Worksheets("Sheet1").Cells(j, 2).Value
If InStr(sConditions, sOrigin) > 0 Then
If InStr(sColumnA, Worksheets("Sheet1").Cells(j, 1).Value) = 0 Then
sColumnA = sColumnA & Worksheets("Sheet1").Cells(j, 1).Value & "/"
End If
If InStr(sColumnB, Worksheets("Sheet1").Cells(j, 2).Value) = 0 Then
sColumnB = sColumnB & Worksheets("Sheet1").Cells(j, 2).Value & "/"
End If
iColumnC = iColumnC + Worksheets("Sheet1").Cells(j, 3)
iColumnD = iColumnD + Worksheets("Sheet1").Cells(j, 4)
End If
Next j
sColumnA = Left(sColumnA, Len(sColumnA) - 1) 'remove last "/"
sColumnB = Left(sColumnB, Len(sColumnB) - 1) 'remove last "/"
Worksheets("Sheet1").Cells(i, 8).Value = sColumnA
Worksheets("Sheet1").Cells(i, 9).Value = sColumnB
Worksheets("Sheet1").Cells(i, 10).Value = iColumnC
Worksheets("Sheet1").Cells(i, 11).Value = iColumnD
Next i
End Sub
It's been 6 years since I've worked with Excel and i'm a little bit rusty. Here's my scenario:
I am exporting a list of issues to Excel. I need to be able differentiate the associated Link numbers in a cell (mulitple values) from each other. Example, i have two columns,
Key = the number for a ticket
Linked Issues = The Keys associated
I need a statement that would scan the Key column and find a match in the Linked Issues column. Then once the match is found the matching text will assume the font color of the Key.
Where this get complicated is each cell of the Linked Issues column could look something like this iss-3913, iss-3923, iss-1649. So essentially the scan would be for a match within the string. Any help is appreciated.
I am sorry, I don't have time to finish this right now, but wWould something like this help with maybe a loop for each cell in the first column?
Edit: Finished now, second edit to update to B5 and Z5, edit 3 fixed goof with column reference and updated to use variables to assign what column to look in.
Sub colortext()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
o = start_row 'start with row one for second column
Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then 'if cell contents found in cell
With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
.Color = Cells(i, key_col).Font.Color 'change color of this part of the cell
End With
End If
o = o + 1 'increment the cell in second column
Loop
i = i + 1 'increment the cell in the first column
Loop
End Sub
or maybe
Something like this?
Excel VBA: change font color for specific char in a cell range
This is an old post but I thought I would provide my work around to the conditional formating issue I was having.
Sub colorkey()
start_row = 5
key_col = 2
flag_col = 4
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
Tval = Cells(i, flag_col).Value
Select Case Tval
Case "Requirement"
'cval = green
cVal = 10
Case "New Feature"
'cval = orange
cVal = 46
Case "Test"
'cval = lt blue
cVal = 28
Case "Epic"
'cval = maroon
cVal = 30
Case "Story"
'cval = dk blue
cVal = 49
Case "Theme"
'cval = grey
cVal = 48
Case "Bug"
'cval = red
cVal = 3
Case "NOT MAPPED"
'cval = Maroon
cVal = 1
End Select
Cells(i, key_col).Font.ColorIndex = cVal
i = i + 1 'increment the cell in the first column
Loop
End Sub
Sub colorlinked()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
o = start_row 'start with row one for second column
Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then 'if cell contents found in cell
With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
.Color = Cells(i, key_col).Font.Color 'change color of this part of the cell
End With
End If
o = o + 1 'increment the cell in second column
Loop
i = i + 1 'increment the cell in the first column
Loop
MsgBox "Finished Scanning"
End Sub