When I run the program, nothing happens. I think it's because I am not using the right variable types or I am not doing variable and value assignment properly.
This is what I want the code to do:
For every cell from row 80, column 6 to row 90, column 6, I want j to be the INTEGER specified in that cell. For every column from 10 to 100, if the DATE in Cells(i,2) is the same as the DATE in Cells(1,k), then I want to set Cells(j, k) as the INTEGER found in Cells(j, 6).
Please help me correct this code.
Sub TestSub()
Dim i As Integer, i2 As Integer, i3 As Integer
Dim j As Integer, j2 As Integer, j3 As Integer
Dim k As Integer, k2 As Integer, k3 As Integer
For i = 81 To 95
j = Cells(i, 6) 'j becomes the row # of the equipment
For k = 8 To k = 115
If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(j, 6) 'Cells(i,2)->NEXT PM DATE Cells(1,k)->CALENDER DATE (MM/1/YY)
Next k
Next i
For i2 = 97 To 105
j2 = Cells(i2, 6)
For k2 = 8 To k2 = 115
If Cells(i2, 2) = Cells(1, k2) Then Cells(j2 + 1, k2) = Cells(j2 + 1, 6)
Next k2
Next i2
For i3 = 107 To 121
j3 = Cells(i3, 6)
For k3 = 8 To k3 = 115
If Cells(i3, k3) = Cells(j3, 6) Then Cells(j3 + 2, k3) = Cells(j3 + 2, 6)
Next k3
Next i3
End Sub
Have to post a second answer as the asker changed entirely the code:
These lines will never work
For k = 8 To k = 115
For k2 = 8 To k2 = 115
For k3 = 8 To k3 = 115
Change to the correct format
For k = 8 To 115
For k2 = 8 To 115
For k3 = 8 To 115
Then try
The problem is you got confused because you used single-letter variable names and made a mistake in your code that is not easily identifiable. To correct the error, change this line:
If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(j, 6)
To be this instead:
If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(i, 6)
Notice the only difference is that instead of setting it to Cells(j, 6) it needs to be set to Cells(i, 6). This is a common mistake for new programmers, and is the exact reason that using descriptive variable names is good practice. It will prevent simple errors like this.
This is what your code is doing:
It compares the dates for each cell in range B80:B90 (rows 80 to 90) with the dates of cells in range J1:CV1 (columns 10 to 100)
If the dates compared are equal then it takes the value in the same row and column 6 (F). This value is then used to reference a row number and places that row number in the column that contains the same date.
The program is validating the dates in range B80:B90 with the dates in range J1:CV1 and for those found equal is updating the corresponding cell in the row determined by the corresponding value in the range F80:F90.
Let’s look at the following sample case, where the date in cell B80 equals the date in cell J1 and the value in cell F80 is 97.
Then the program will enter the value of cell F97 in cell J97
Dim i As Integer, j As Integer, k As Integer
For i = 80 To 90
If i = 89 Then Stop
j = Cells(i, 6)
For k = 10 To 100
'as per the sample case
'i = 80 ; j = 97 and k = 10
'date in cell(B80) = date in cell(J1)
'If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(j, 6)
'then J97 = F97
'Replaced with:
If Cells(i, 2) = Cells(1, k) Then Cells(j, 6) = Cells(i, 6)
Next k: Next
Therefore, if it seems that the program is doing nothing and could not see any result is either because there are no equal dates in the ranges compared or because results are expected to be shown in the range J80:CV90 but the values in range F80:F90 are determining a different output range (i.e. the values in range F80:F90 are lower than 80 or higher than 90.
I asked for the values in range F80:F90 to be provided to validate the above.
So if the objective is:
If the dates are equal, then it takes the value in the same row and column 6 (F) and inserts that value into cells(j, 6)
Then replaced line
If Cells(i, 2) = Cells(1, k) Then Cells(j, k) = Cells(j, 6)
with line
If Cells(i, 2) = Cells(1, k) Then Cells(j, 6) = Cells(i, 6)
The value of j is the value in cell(i,6) as determined by the line:
j = Cells(i, 6)
Basically if the date in cell B80 is found in Range J1:CV1 then enters 73, value in cell F80 or Cell(i,6), into cell F73 or Cell(j,6).
Related
I know that this code can be easily rewritten to use a loop, but I can't.
k1 = (exk - 3 * increment)
k2 = k1 + 0.01
k3 = k2 + 0.01
k4 = k3 + 0.01
k5 = k4 + 0.01
k6 = k5 + 0.01
k7 = k6 + 0.01
Cells(7, 2).Value = k1
Cells(8, 2).Value = k2
Cells(9, 2).Value = k3
Cells(10, 2).Value = k4
Cells(11, 2).Value = k5
Cells(12, 2).Value = k6
Cells(13, 2).Value = k7
Here you are:
Sub Rewrite_Code()
Dim k() As Double
Dim i As Integer
Const x = 7
ReDim k(x)
k1 = (exk - 3 * increment)
'Redim Preserve k(i+1) '(this can using when program situation interactively changes)
For i = 1 To x
k(i + 1) = k(i) + 0.01
ActiveSheet.Cells(i + 6, 2).Value = k(i)
Next i
End Sub 'Rewrite
Perhaps this is what you mean?
Const FirstRow As Long = 7
Dim K1 As Double
Dim i As Long
K1 = 13 ' your formula is (exc - 3) * increment
For i = 1 To 7
Cells(i + FirstRow - 1, 2).Value = K1
K1 = K1 + 0.01
Next i
Option Explicit
Public Sub ForNext()
Dim ws As Worksheet, r As Long, arr As Variant, exk As Long, increment As Long
Set ws = ThisWorkbook.Worksheets("Sheet1") 'set the name of your Worksheet
exk = 5
increment = 1
arr = ws.Range(ws.Cells(7, 2), ws.Cells(13, 2)) 'copy range to array
arr(1, 1) = (exk - 3) * increment 'set first array item
For r = 2 To 7
arr(r, 1) = arr(r - 1, 1) + 0.01 'set the rest of the items
Next
ws.Range(ws.Cells(7, 2), ws.Cells(13, 2)) = arr 'copy array back to range
End Sub
copy the range to array (B7:B13); the first item in array (B7) starts at index 1 - arr(1, 1)
set the first element in the array to your formula: arr(1, 1) = (exk - 3) * increment
iterate over the rest of the array, increment each element based on the previous value
place the array back on the range
one dimension array sample
Sub test()
Dim exk, increment
Dim vResult()
Dim i As Integer
exk = 5 'setting your value
increment = 2 'setting your value
ReDim vResult(1 To 7) 'array one dimension
vResult(1) = exk - 3 * increment
For i = 2 To 7
vResult(i) = vResult(i - 1) + 0.01
Next i
Range("b7").Resize(7) = WorksheetFunction.Transpose(vResult)
End Sub
Dim i As Integer, j As Integer, k As Integer, l As Integer
i = ActiveSheet.PivotTables(1).TableRange2.Rows.Count + 1
j = ActiveSheet.PivotTables(1).TableRange2.Columns.Count
k = ActiveSheet.PivotTables(1).TableRange2.Rows.Count - 7
For l = 2 To j
Cells(i + 2, l).Value = WorksheetFunction.SumIf(Range(Cells(9, l), Cells(i, l)), ">0", Range(Cells(9, l), Cells(i, l)))
Next l
Hi, I am trying to use sumif function in vba. The point is to do this in loop, which depends on the number of columns. I do not actually now what is wrong here, but I think that probably there is something with criteria I took. I want to sum all cells with number higher than 0 and not sure how to write this.
Use the following function. No need to use "*" for comparing
Cells(i + 2, l).Value = Aplication.WorksheetFunction.SumIf(Range(Cells(9, 2), Cells(i, 2)), "> 0", Range(Cells(9, 2), Cells(i, 2)))
If in your SumIf you are using the Range you are comparing with the Criteria (>0) also as the Range to sum, there is no need to add it inside the SumIf as the third argument.
You could go with the code below:
For l = 2 To j
Cells(i + 2, l).Value = WorksheetFunction.SumIf(Range(Cells(9, l), Cells(i, l)), ">0")
Next l
I have data in column B that I need to loop through and then copy the corresponding value in column D for each row, to another sheet in the same workbook.
I need a code written to search through every value in Column B, return the corresponding value in Column D for the same row, and then find the next numbers in order from the given range(in this case I have set it from 7 to 10).
So loop through Column B, find values 7, 7a, 8, 9, 10 in that order (even if a larger value is located before a lower value as you go down), and copy the corresponding values in Column D to another sheet.
Excel Data Chart in Sheet3 (Column A is not needed):
A B C D E
1 1a 78.15 77.68 This is row 7
1a 2 77.18 76.92
2 3 76.92 76.63
3 4 76.13 75.78
4 4a 75.78 75.21
4a 5 75.11 74.87
5 5a 74.87 74.69
5a 6 73.94 73.6
6 6a 73.1 72.71
6a 6b 72.41 72.18
6b 10 72.18 71.6
10 11 71.3 70.89
11 12 70.89 69.83
12 13 69.83 68.68
13 14 68.68 67.68
14 15 67.63 66.46
15 16 66.01 64.84
16 16a 64.24 63.72
16a 16b 56.82 56.37
16b 16c 56.37 55.18
16c OUT 47.28 47.27
7 7a 83.12 76.07
7a 8 76.17 75.99
8 9 74.79 74.41
9 6 74.51 74 This is row 31
My problem: When the code encounters a cell containing letters AND numbers, it skips that cell and moves to the next cell in that range containing only numbers. How do I edit/re-write the code to INCLUDE alphanumeric values in the search criteria?
Here is my code that loops through column B but excludes cells with letters and numbers:
Sub EditBEST()
Dim Startval As Long
Dim Endval As Long 'Finds values corresponding
'to input in B and C
Dim LastRow As Long
LastRow = Sheets("Sheet3").range("B" & Rows.Count).End(xlUp).Row
Startval = Worksheets("Sheet3").Cells(1, "O").Value
Endval = Worksheets("Sheet3").Cells(1, "P").Value
StartRow = 2 'row that first value will be pasted in
For x = 7 To LastRow 'decides range to search thru in "Sheet3"
If Sheets("Sheet3").Cells(x, 2).Value >= 7 And Sheets("Sheet3").Cells(x, 2).Value <= 10 Then 'if cell is not blank
Sheets("Sheet4").Cells(StartRow, 2).Value = _
Sheets("Sheet3").Cells(x, 4).Value 'copy/select cell value in D
StartRow = StartRow + 1 'cell.Offset(0, 1).Value =
End If
If Sheets("Sheet3").Cells(x, 3) >= 7 And Sheets("Sheet3").Cells(x, 3).Offset(0, 1) <= 10 Then
Sheets("Sheet4").Cells(StartRow, 2).Value = _
Sheets("Sheet3").Cells(x, 5).Value
StartRow = StartRow + 1
End If
Next x
End Sub
Thank you
The main issue you are having is that you're conditional check filters out any string values. As # Grade 'Eh' Bacon pointed out, you need to provide some way to handle string values.
You also have some comments that are wrong or misleading.
For example, here, you have added the comment "if cell is not blank" but this is not what you are actually checking.
If Sheets("Sheet3").Cells(x, 2).Value >= 7 And Sheets("Sheet3").Cells(x, 2).Value <= 10 Then 'if cell is not blank
If you want to check if a cell is blank, you can check it's length. E.g.:
If Len(Sheets("Sheet3").Cells(x, 2).Value) > 0 Then
Now, that's really not entirely necessary for this procedure, but I just wanted to point it out since your comment indicates you were trying to do something different than your code was doing.
I haven't tested your code, but I wrote a function for pulling a single out of a string for you. This is all untested, so you may need to debug it, but should get your string problem sorted.
Sub EditBEST()
Dim Startval As Long
Dim Endval As Long 'Finds values corresponding
'to input in B and C
Dim StartOutputRow as Long
Dim LastRow As Long
Dim Val as Long
Dim Val2 as Long
LastRow = Sheets("Sheet3").range("B" & Rows.Count).End(xlUp).Row
Startval = Worksheets("Sheet3").Cells(1, "O").Value
Endval = Worksheets("Sheet3").Cells(1, "P").Value
StartOutputRow =2 'first row we will output to
OutputRow = StartOutputRow 'row of the cell to which matching values will be pasted
For x = 7 To LastRow
Val = GetSingleFromString(Sheets("Sheet3").Cells(x, 2).Value)
If Val >= 7 And Val <= 10 Then 'if value is within range
Sheets("Sheet4").Cells(OutputRow , 2).Value = _
Sheets("Sheet3").Cells(x, 4).Value 'copy cell value from D #the current row to column B #the output row
OutputRow = OutputRow + 1 'Next value will be on the next row
End If
Val = GetSingleFromString(Sheets("Sheet3").Cells(x, 3).Value)
Val2 = GetSingleFromString(Sheets("Sheet3").Cells(x, 3).Offset(0, 1).Value)
If Val >= 7 And Val2 <= 10 Then
Sheets("Sheet4").Cells(OutputRow , 2).Value = _
Sheets("Sheet3").Cells(x, 5).Value 'copy cell value from E #the current row to column B #the output row
OutputRow = OutputRow + 1
End If
Next x
'Sort the output:
Sheets("Sheet4").Range("B:B").Sort key1:=Range(.Cells(StartOutputRow,2), order1:=xlAscending, header:=xlNo
End Sub
Private Function GetSingleFromString(ByVal InString As String) As Single
If Len(InString) <= -1 Then
GetSingleFromString = -1
Exit Function
End If
Dim X As Long
Dim Temp1 As String
Dim Output As String
For X = 1 To Len(InString)
Temp1 = Mid(InString, X, 1)
If IsNumeric(Temp1) Or Temp1 = "." Then Output = Output & Temp1
Next
If Len(Output) > 0 Then
GetSingleFromString = CSng(Output)
Else
GetSingleFromString = -1
End If
End Function
I wrote a macro to insert a row between cells when their values are different. I have 9 columns in my data and the data starts at row 2. I want my macro to check all the values down column 3 (also known as column "C") and as it goes through, if the value changes (i.e. 2, 2, 2, 3, 3) it will insert a row between the changed value (i.e. 2, 2, 2, INSERT ROW, 3, 3). The problem is, my macro is reading column 5(E) not 3(C). What is wrong with it, I can't figure it out! The reason I know this too is because I placed a msgbox to spit the value of the cell and it matches everything in column 5 but not 3. Here is my code:
Sub Dividers()
Dim DividerRange As Range, lastrow As Long, k As Integer, counter As Integer
lastrow = Range("C2").End(xlDown).Row
Set DividerRange = Range(Cells(2, 3), Cells(lastrow, 3))
counter = 0
For k = 2 To DividerRange.Count
MsgBox DividerRange(k + counter, 3).Value
If DividerRange(k + counter, 3).Value = DividerRange(k + counter - 1, 3).Value Then
DividerRange(k + counter, 3).EntireRow.Insert
counter = counter + 1
Else
End If
Next k
End Sub
DividerRange(k + counter, 3).Value is a relative reference. DividerRange is a range starting at C2, so when you ask for the (i,j)th cell, i.e. (i,3) you get something from column E where jth columns would be: (C = 1, D = 2, E = 3)
You can simplify it quite a lot, there's no need for the Range or Range count, or counter:
Sub Dividers()
Dim lastrow As Long, k As Integer
lastrow = Range("C2").End(xlDown).Row
For k = 2 To lastrow
If Cells(k, 3).Value <> Cells(k - 1, 3).Value Then
Cells(k, 3).EntireRow.Insert
'Now skip a row so we don't compare against the new empty row
k = k + 1
End If
Next k
End Sub
I wrote a quick script to sum everything in column E if everything is equal in column A, C, and D. I am getting an error and the actual sum function isn't working. Do you know why this would be happeing?
For i = 36 To 714 Step 1
Count = 0
If Cells(i, 7) <> 1 Then
x = i + 1
Do While x <> 714
Count = Cells(i, 5)
If Cells(i, 1) = Cells(x, 1) And Cells(i, 3) = Cells(x, 3) And Cells(i, 4) = Cells(x, 4) Then
Cells(x, 7) = 1
Count = Count + Cells(x, 5)
End If
x = x + 1
Loop
Cells(i, 6) = Count
End If
Next
As long as i reaches 714, x becomes 715 which is not equal to 714 and then do while loop stuck with eternal x. Use <= instead.